關於range的錯誤1004.paste

Question

我現在生氣了一個宏。

我花了在互聯網上尋找解決的辦法小時，但我來到這裏我要尋求幫助:(

我得到一個

運行時錯誤「1004」點應用程序定義或對象定義的錯誤

在這條線：Range(rngZelle1.Offset(1, 2)).Paste

Option Explicit 

Sub import() 
Dim bk As Workbook 
Dim sh, asheet As Worksheet 
Dim rngZelle, rngZelle1 As Range 
Dim strSuchwort, sDate, sPath, sName As String 

Application.ScreenUpdating = False 

Set sh = ActiveSheet 
strSuchwort = "test" 

sPath = "C:\Users\stefan.******\Downloads\" 'you dont need to know my real name :P 
sName = Dir(sPath & "*.xl*") 
Do While sName <> "" 
Set bk = Workbooks.Open(sPath & sName) 

For Each asheet In ActiveWorkbook.Worksheets 
asheet.Activate 
    For Each rngZelle In Range("A:A") 
       If UCase(rngZelle) Like UCase(strSuchwort) Then 

       sDate = Right(rngZelle, 10) 
       Range(rngZelle.Offset(2, 1), rngZelle.Offset(25, 1)).copy 

       For Each rngZelle1 In sh.Range("A:A") 
       If rngZelle1 = sDate Then 

       Range(rngZelle1.Offset(1, 2)).Paste '<---- thats the line i get the error 

       End If 
       Next rngZelle1 
      End If 
    Next rngZelle 
Next asheet 

一切順利到提到的線。我試圖用「msgbox sdate」替換它以達到測試目的。

我真的沒有得到，在以前的循環中複製順利。這似乎是關於粘貼線。

我希望你們中的一個人可以幫助一個完全noob出:)每一個幫助真的很感激，因爲我越來越瘋狂。

Answer 1

Paste是一個Workbook方法，它不能在Range對象上使用。

對應的Range方法是PasteSpecial，它取4個可選參數。 粘貼參數需要一個xlPasteType默認爲xlPasteAll。爲了清楚起見，即使使用默認值，我通常也會包含xlPasteType。

如果更改：

Range(rngZelle1.Offset(1, 2)).Paste

到：

Range(rngZelle1.Offset(1, 2)).PasteSpecial xlPasteAll

您的代碼應工作。

Answer 2

繼@Scott克萊納和@ user3598756上述評論，有幾個「更正」需要做：

Dim sh, asheet As Worksheet意味着和sh As Variant。

同樣去Dim rngZelle , rngZelle1 As Range，只有第二個是Range而rngZelle As Variant。

在結束聲明的第一部分，它應該是：

Dim bk As Workbook 
Dim sh As Worksheet, asheet As Worksheet 
Dim rngZelle As Range, rngZelle1 As Range 
Dim strSuchwort As String, sDate As String, sPath As String, sName As String 

關於For Each asheet In ThisWorkbook.Worksheets循環：

1. 沒有必要asheet.Activate，您可以用With asheet代替。

2. 關於你的錯誤，如果你複製粘貼>>在 2行代碼，你需要更換Paste行`PasteSpecial的xlPasteAll的語法。

對於每個asheet循環代碼

For Each asheet In ThisWorkbook.Worksheets 
    With asheet 
     For Each rngZelle In .Range("A:A") 
      If UCase(rngZelle.Value) Like UCase(strSuchwort) Then 

       sDate = Right(rngZelle.Value, 10) 
       Range(rngZelle.Offset(2, 1), rngZelle.Offset(25, 1)).Copy 

       For Each rngZelle1 In sh.Range("A:A") 
        If rngZelle1.Value = sDate Then 
         rngZelle1.Offset(1, 2).PasteSpecial xlPasteAll 
        End If 
       Next rngZelle1 
      End If 
     Next rngZelle 
    End With 
Next asheet 

Answer 3

對不起，我遲到的答覆。不幸的是，過去幾周我沒有太多時間。

首先，.PasteSpecial做的工作:)非常感謝！

Dim sh, asheet As Worksheet意味着和sh As Variant

非常感謝你的小費，我學到新的東西:)

不幸的是，with asheet和end with導致宏觀什麼不復制粘貼數字，所以我堅持循環。

我設法構建了一個最終的工作宏，但它需要90分鐘才能運行（最終版本將導入5次當前數據）並在運行時阻止剪貼板。

因此，如果任何人有任何想法如何加快速度並繞過剪貼板（複製目的地等無法正常工作），這將是非常感激。

Option Explicit 

Sub import() 
Dim bk As Workbook 
Dim sh As Worksheet, asheet As Worksheet 
Dim sSkill As Range, pval As Range, lstZelle As Range, target As Range, stype As Range, lstZelle1 As Range 
Dim strSuchwort As String, sDate As String, sPath As String, sName As String, strSuchwort1 As String, strSuchwort2 As String 
Dim row As Integer, col As Integer 

Application.ScreenUpdating = False 

Set sh = ActiveSheet 
sPath = "C:\Users\*******\test\" 
sName = Dir(sPath & "*.xl*") 

Do While sName <> "" 
Set bk = Workbooks.Open(sPath & sName) 

sh.Range("A1").AutoFilter field:=1, Criteria1:="<>" 
For Each lstZelle In sh.Range("B:B") 
If lstZelle <> "" Then 
strSuchwort = lstZelle & "*" 
strSuchwort2 = lstZelle.Offset(0, -1) 

    For Each lstZelle1 In sh.Range("C:C") 
    If lstZelle1 <> "" Then 
    strSuchwort1 = lstZelle1 

     For Each asheet In ActiveWorkbook.Worksheets 
     asheet.Activate 
     If asheet.Name = strSuchwort2 Then 

      For Each sSkill In Range("A:A") 
      If UCase(sSkill) Like UCase(strSuchwort) Then 
      sDate = Right(sSkill, 10) 

       For Each stype In Range(sSkill.Offset(1, 0), sSkill.Offset(1, 100)) 
       If UCase(stype) Like UCase(strSuchwort1) Then 
       Range(stype.Offset(1, 0), stype.End(xlDown)).copy 

        For Each pval In sh.Range("1:1") 
        If pval = sDate Then 
        col = pval.Column 
        row = lstZelle.row 
        sh.Cells(row, col).PasteSpecial xlPasteValues 

        End If 
        Next pval 
       End If 
       Next stype 
      End If 
      Next sSkill 
     End If 
     Next asheet 
    End If 
    Next lstZelle1 
End If 
Next lstZelle 

bk.Close SaveChanges:=False 
sName = Dir() 

Loop 
Application.ScreenUpdating = True 
sh.AutoFilterMode = False 

End Sub