range.paste上的错误1004

我现在正在疯狂的macros观。

我花了几个小时在互联网上寻找解决scheme，但我来到了我必须要求帮助:(

我得到了

运行时错误“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”replace它以达到testing目的。

我真的没有得到，在以前的循环复制顺利。 这似乎是关于粘贴线。

我希望你们中的一个能够帮助一个完全noob out :)每一个帮助真的很感激，因为我越来越疯狂。

Answer 1

Paste是一个工作簿方法，不能在一个Range对象上使用。

相应的Range方法是PasteSpecial ，它有4个可选参数。 Paste参数默认使用一个xlPasteType ，它是xlPasteAll 。 为了清楚起见，即使使用默认值，我通常也会包含xlPasteType。

如果你改变：

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

至：

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

你的代码应该工作。

Answer 2

根据@Scott Craner和@ user3598756的评论，需要进行一些修正：

Dim sh, asheet As Worksheet means asheet As Worksheet and 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循环中的For Each asheet In ThisWorkbook.Worksheets ：

1. 没有必要asheet.Activate ，你可以用With asheet来代替。

2. 关于你的错误，如果你复制>>粘贴到2个代码行中，你需要将Paste行的语法replace为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 means asheet As Worksheet and sh As Variant

非常感谢你的提示，我学到了新的东西:)

不幸的是， with asheet和结果macros在什么不复制和粘贴的数字，所以我坚持循环。

我设法构build了一个最终的工作macros，但运行需要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