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

Why am I getting Run-time error '1004' with my VBA code to copy and paste from one workbook to another?

我的宏 VBA 代码有问题,我想打开 msoFileDialogFolderPicker 并且用户选择一个文件夹,其中所有 excel 文件将被一个一个地打开数据将从新打开的工作簿中复制并粘贴到工作簿中宏为 运行ning 的特定工作表中。基本上,我们给每个销售代表一个电子表格来填写他们的销售额,然后他们将电子表格提交给销售经理。我想做的不是让别人手动打开每个电子表格并复制数据并将其全部粘贴到一个电子表格中,而是简单地拥有一个为我执行此操作的宏。由于文件的位置和名称可以更改,因此我试图使其尽可能动态。可能有更好的方法,所以非常感谢任何建议!

我遇到的问题是我打开文件并复制它们,但是当我尝试将其粘贴到运行正在使用宏的工作簿。我已尝试使用 ThisWorkbook 和 ThisWorkbook.Activate 来告诉 Excel 转到宏为 运行ning 的电子表格,但 none 解决了我的问题。有时我克服了错误,但它仍然没有将数据粘贴到主工作簿中。我的代码写在下面。不可否认,它主要是从我找到的代码中复制的,但我已尝试根据我的目的对其进行调整。我收到错误的行是 "wb1.Worksheets(1).Range("A5").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

这是我最终要做的事情的简化版本,其中包括从新打开的工作簿中的多个工作表中复制内容,并将它们粘贴到原始宏-运行ning 工作簿的多个工作表中。然而,在这一点上,我只是想让这个简单的版本达到 运行 并开始工作。感谢大家的帮助,对于冗长的代码我深表歉意,但我想让每个人都知道我在做什么。谢谢!

停止使用 SelectActivate 并编写使用 Selection 的代码 - 这是用于宏记录器的。你不是宏录制者,你可以写出比这更好的代码。

这会做太多事情,让您陷入 late-bound 调用的陷阱 Object,这意味着您在没有任何 IntelliSense[=40 帮助的情况下盲目输入代码=],没有自动完成,没有工具提示:

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

你想要一个 Range 对象。

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...