创建循环以打开多个文件并将数据复制到 VBA excel 中的主文件答案

【问题标题】：Create loop to open multiple files and copy data to a master file in VBA excel创建循环以打开多个文件并将数据复制到 VBA excel 中的主文件
【发布时间】：2016-10-27 08:00:18
【问题描述】：

我有多个文件，其中的数据需要转置到一个主文件中，所有数据都放在一行中。

我是一个完全的编程菜鸟，所以如果我到目前为止的代码没有任何意义，那么请随时更改它

我可以从 www.TheSpreadsheetGuru.com 找到这个“在文件夹中循环所有 excel 文件”的代码。该代码工作得非常好，它会单独打开文件夹中的每个文件，然后将其关闭，然后打开下一个文件并关闭它，直到它浏览完该文件夹中的每个文件。

但是，我想在循环中插入一个“复制和粘贴数据”代码循环。所以需要发生的是，代码将打开文件夹中的“File1”，然后将数据复制并粘贴到单元格 A4 中的“主文件”中。然后它将关闭“File1”，然后打开“File2”并将数据复制到单元格A5的“Master File”中，然后关闭“File2”。它将重复此操作，直到文件夹中的所有文件都已打开/关闭。

这是我现在拥有的代码，但我无法让复制和粘贴代码正常工作。我很难弄清楚如何设置循环，代码将知道它当前在哪个文件上，并为它粘贴到的主文件的单元格设置一个计数器。

Sub LLoopAllExcelFilesInFolder()

'PURPOSE: To loop through all Excel files in a user specified folder and   perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com

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

'Optimize Macro Speed
 Application.ScreenUpdating = False
 Application.EnableEvents = False
 Application.Calculation = xlCalculationManual

 'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

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

'In Case of Cancelhow
NextCode:
 myPath = myPath
 If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
 myExtension = "*.xlsx"

'Target Path with Ending Extention
 myFile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
  Do While myFile <> ""
'Set variable equal to opened workbook
  Set wb = Workbooks.Open(Filename:=myPath & myFile)

'THIS IS MY COPY AND PASTE CODE (DOESN'T WORK)
 Dim row As Integer
 While row = 4

 Workbooks("Filename:=myPath & myFile").Worksheets("Resin Log").cell("I5") = Workbooks("Workbook1.xlsm").Worksheets("Sheet1").Range("A" & row).Value
 Next row

'Save and Close Workbook
 wb.Close SaveChanges:=False

'Get next file name
  myFile = Dir
  Loop

'Message Box when tasks are completed
  MsgBox "Task Complete!"

 ResetSettings:
 'Reset Macro Optimization Settings
 Application.EnableEvents = True
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True

 End Sub

【问题讨论】：

如果你不提供任何代码，很难说它是否可以工作......
另外，如果您搜索 SO 甚至 google，您一定会在某处找到这个确切的代码。这是一项非常常见的任务 - 只是建议更深入地搜索
对不起，我应该添加复制和粘贴代码。我试过浏览谷歌，但它们都不适用于我的情况。代码需要打开它所在的当前文件，从特定单元格复制数据，并将其粘贴到主文件中。例如，打开“File1”，复制单元格“C1”，并将其粘贴到单元格“A4”的“主文件”中，然后关闭“File1”。然后它打开“File2”，复制“C1”，并将其粘贴到单元格“A5”的“主文件”中并关闭“File2”。然后它将打开“File3”，复制“C1”，并将其粘贴到单元格“A6”的主文件中，并关闭“File3”。等等……
好吧，我想通了。我刚刚添加了这段代码 wb.Activate Range("L1:M1").Select Selection.Copy Windows("Bldg 4 - Resin Log - Master - 1.xlsm").Activate Range("A" & row).Select Selection .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone _, SkipBlanks:=False, Transpose:=False
我在下面更新了我的示例，说明如何在不使用.Copy 的情况下进行复制，也就是说，如果你想要/需要，那么至少你不应该使用.Activate' or .Select. To avoid those A) Use Workbooks("Fill_In_WB_Name").Worksheets("FIll_In_WS_Name")` 指定哪个工作簿和工作表； B) 而不是 Range("rng").Select 将 .Range("rng") 附加到 A 中的代码以指定要使用的单元格； C) 而不是 Selection.Copy 追加 .copy 或 .PasteSpecial xlPasteValues。不需要 Select & Activate 语句，这确实会减慢您的代码速度。有关其他最佳做法，请参阅我的更新答案。

标签： vba excel loops copy

【解决方案1】：

有可能做你所说的。我建议，尝试在直接创建的文件中设置单元格值

targetworkbook.worksheets(1).Range("A1").value = sourceworkbook.Worksheets(1).Range("C4").value

而不是使用.Copy 和.Paste，这样如果宏需要一段时间才能运行，您不会被锁定在其他应用程序中使用复制/粘贴。如果您仍然不确定该怎么做，请尝试打开录制宏。生成的代码需要进行调整，但会为您提供所需的大部分内容。

另外，请务必查看 this link 以了解其他一些要避免在您的代码中使用的内容。

【讨论】：

问题是我需要“复制和粘贴代码”从循环所在的当前文件中复制数据。因此，循环打开第一个文件，例如“File1”并将“主文件”复制到单元格 A4 中。然后循环关闭“文件1”，打开“文件2”，并将数据复制到“主文件”到单元格A5中。它将通过 File3 并向前，将数据复制到单元格 A6 等等。但是，我是一个完整的 excel 菜鸟，并尝试了许多来自谷歌的差异代码，但没有运气
不，我明白这是意图。完善我的示例，如果 MasterFile 是工作簿变量 mf，而 wb 是 File1，您将使用 mf.worksheets(1).Range("A4").Value = wb.Worksheets(1).Range("A4").value。这与复制值具有相同的效果，而无需实际执行复制，就像我说的那样，这可以防止您按 Ctrl+C 在另一个应用程序中复制并搞砸您的输出。