我为什么会收到运行时错误' 1004'使用我的VBA代码从一个工作簿复制并粘贴到另一个工作簿?

时间:2017-01-24 16:15:15

标签: excel vba copy-paste doevents selectmethod

我的宏的VBA代码出现问题,我想打开msoFileDialogFolderPicker,用户选择一个文件夹,其中将打开所有excel文件,并从新打开的工作簿中复制逐个数据粘贴到运行宏的工作簿中的特定工作表中。基本上,我们为每个销售代表提供一个电子表格来填写他们的销售,然后他们将他们的电子表格提交给销售经理。我想要做的不是必须打开每个电子表格并复制数据并将所有数据手动粘贴到一个电子表格中,而是只需要一个宏来为我做这个。由于文件的位置和名称可以更改,我试图使其尽可能动态。可能有更好的方法,所以任何建议都非常感谢!

我遇到的问题是我将文件打开并复制,但后来我得到了运行时错误1004'范围类的复制方法失败'当我尝试将其粘贴到运行宏的工作簿中时。我尝试过ThisWorkbook和ThisWorkbook.Activate尝试告诉Excel转到宏运行的电子表格,但没有解决我的问题。有时我会通过错误,但它仍然永远不会将数据粘贴到主工作簿中。我的代码写在下面。不可否认,它主要是从我找到的代码中复制而来,但我试图根据我的目的进行调整。我收到错误的那一行是" wb1.Worksheets(1).Range(" A5")。选择"线。

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

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

1 个答案:

答案 0 :(得分:0)

停止使用SelectActivate并编写使用Selection的代码 - 这是宏录制器的代码。你不是一个宏录音机,你可以编写比这更好的代码。

这做了太多事情,并使用Object处理后期绑定调用来捕获你,这意味着你在没有 IntelliSense 的任何帮助的情况下盲目地输入代码,没有自动完成,没有工具提示:

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