1

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

我遇到的问题是我打开文件并复制它们，但是当我尝试将其粘贴到运行宏的工作簿中时，出现运行时错误 1004“范围类的复制方法失败” . 我已经尝试过 ThisWorkbook 和 ThisWorkbook.Activate 来尝试告诉 Excel 转到运行宏的电子表格，但没有解决我的问题。有时我会克服错误，但它仍然不会将数据粘贴到主工作簿中。我的代码写在下面。诚然，它主要是从我找到的代码中复制而来的，但我已尝试根据我的目的对其进行调整。我遇到错误的行是“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

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

4

1 回答 1

0

停止使用Select和Activate编写使用的代码Selection- 那是宏记录器。您不是宏记录器，您可以编写比这更好的代码。

这是在做太多事情，并让你陷入后期绑定调用 work off 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在该循环结束之前调用...

于 2017-01-24T16:40:07.603 回答