Excel 为什么我的VBA代码出现运行时错误“1004”，要从一个工作簿复制并粘贴到另一个工作簿？

我的宏的VBA代码有问题，我想打开msoFileDialogFolderPicker，用户选择一个文件夹，其中所有excel文件都将打开，数据将从新打开的工作簿中逐个复制，并粘贴到运行宏的工作簿中的特定工作表中。基本上，我们会给每个销售代表一份电子表格来填写他们的销售情况，然后他们将电子表格提交给销售经理。我想做的不是有人打开每个电子表格，复制数据并手动粘贴到一个电子表格中，而是简单地有一个宏来为我做这件事。因为文件的位置和名称可以更改，所以我尝试使其尽可能动态。也许有更好的方法可以做到这一点，所以任何建议都非常感谢

我遇到的问题是，我打开了文件并进行了复制，但是当我试图将其粘贴到运行宏的工作簿中时，出现了运行时错误1004“复制Range类的方法失败”。我已尝试使用此工作簿和此工作簿。激活可尝试告诉Excel转到运行宏的电子表格，但没有解决我的问题。有时我会克服错误，但它仍然不会将数据粘贴到主工作簿中。我的代码写在下面。诚然，它大部分是从我找到的代码中复制出来的，但我已经尝试根据我的目的对其进行调整。我得到错误的那一行是wb1.Worksheets1.RangeA5.Select行

Sub LoopAllExcelFilesInFolder()

    Dim wb As Workbook
    Dim wb1 As Workbook
    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String
    Dim FldrPicker As FileDialog

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

  With FldrPicker
    .Title = "Select A Target Folder"
    .AllowMultiSelect = False
      If .Show <> -1 Then GoTo NextCode
      myPath = .SelectedItems(1) & "\"
  End With


NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

myExtension = "*.xls*"

myFile = Dir(myPath & myExtension)

Do While myFile <> ""
  Set wb = Workbooks.Open(Filename:=myPath & myFile)
  Set wb1 = ThisWorkbook

  Do events

  wb.Worksheets(1).Range("A5:H28").Select
Selection.Copy
  wb1.Activate
  wb1.Worksheets(1).Range("A5").Select
  ActiveSheet.Paste

  DoEvents

  myFile = Dir
Loop

  MsgBox "Task Complete!"

ResetSettings:

  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True

End Sub

这是我最终要做的工作的简化版本，包括从新打开的工作簿中的多个工作表复制内容，并将它们粘贴到最初运行宏的工作簿的多个工作表中。然而，在这一点上，我只是想让这个简单的版本运行和工作。谢谢你们所有人的帮助，我为冗长的代码道歉，但我想让大家知道我到底在做什么。谢谢

停止使用“选择并激活”并写入使用“选择”的代码-这是用于宏记录器的代码。你不是一个宏记录器，你可以编写比这更好的代码

这是在做太多的事情，并让您在对象之外工作时受到后期绑定调用的困扰，这意味着您在没有任何IntelliSense帮助的情况下盲目键入代码，没有自动完成，也没有工具提示：

wb.Worksheets(1).Range("A5:H28").Select

这里需要一个范围对象

Dim source As Range
Set source = wb.Worksheets(1).Range("A5:H28")

现在，当您键入source时，IntelliSense可以帮助您。继续，试试：

source.Copy[space]

请注意，工具提示告诉您可以在此处指定目标，然后再指定

因此，再做一个范围：

Dim destination As Range
Set destination = wb1.Worksheets(1).Range("A5")

然后抄走

source.Copy destination

现在，您可能应该在循环结束之前调用wb.Close…

停止使用Select和ACTIVE，并编写使用Select的代码-这是宏记录器的代码。你不是一个宏记录器，你可以编写比这更好的代码

这是在做太多的事情，并让您在对象之外工作时受到后期绑定调用的困扰，这意味着您在没有任何IntelliSense帮助的情况下盲目键入代码，没有自动完成，也没有工具提示：

wb.Worksheets(1).Range("A5:H28").Select

这里需要一个范围对象

Dim source As Range
Set source = wb.Worksheets(1).Range("A5:H28")

现在，当您键入source时，IntelliSense可以帮助您。继续，试试：

source.Copy[space]

请注意，工具提示告诉您可以在此处指定目标，然后再指定

因此，再做一个范围：

Dim destination As Range
Set destination = wb1.Worksheets(1).Range("A5")

然后抄走

source.Copy destination

---

现在，您可能应该在循环结束之前致电wb.Close…

好的，谢谢。我想我正在让它发挥作用，但我计划明天再解决它，所以我想保持线程打开，以确保。另外，您知道如何在循环中进行复制和粘贴，而不是在现有数据上进行写入/粘贴吗？基本上所有数据都放在一个表中，一个表可以粘贴在另一个表下。在msofolderpicker中打开的某些工作簿将有90个条目，而有些工作簿可能只有50个条目。没有办法得到一个精确的数字，所以我需要在这个意义上保持它的动态性。好的，谢谢。我想我正在让它发挥作用，但我计划明天再解决它，所以我想保持线程打开，以确保。另外，您知道如何在循环中进行复制和粘贴，而不是在现有数据上进行写入/粘贴吗？基本上所有数据都放在一个表中，一个表可以粘贴在另一个表下。在msofolderpicker中打开的某些工作簿将有90个条目，而有些工作簿可能只有50个条目。没有办法得到一个精确的数字，所以我需要在这个意义上保持它的动态性。