Vba 从文件夹中的多个工作簿复制到文件夹中的摘要工作簿？

我有一个包含100多本工作簿的文件夹。这些工作簿包含一系列数据。为简单起见，我将数据范围称为A1:D2，该范围位于所有100多本工作簿的表1上

我还有一份总结手册

我想将VBA代码放在循环遍历文件夹的摘要工作簿中，复制100多本工作簿的A1:D2范围

然后，我想将每个工作簿中的A1:D2范围粘贴到摘要工作簿的Sheet1中。每个粘贴将从下一个未使用的行开始

我现在被困在一个手动过程中，这让我发疯

我确实知道一些基本的VBA编码，但我的问题是，我不知道如何正确地循环它，我一直在为每个工作簿编码，以打开-->复制-->粘贴-->关闭。有10到20本作业本就可以了，但现在我已经100+了，而且每周都在增长

再次感谢

---

Brian

我有一些东西完全符合您的要求，如果您想复制多个工作簿，我建议创建一个新的工作表，将工作簿信息捕获到电子表格中。下面的说明

创建一个新的工作表并为其命名，在本例中，我们将该工作表称为“控件”

在VBA中创建一个新模块，并使用下面的代码操作工作簿副本

我已经为您留下了一个部分，让您为要执行的函数编写代码

子工作簿合并器（）

`试试这个

Sub combine_into_one()
Dim FSO As Object: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim strPath$, Pivot$, sUserName$, sFolderName$, sSourceName$, x&
Dim oFldialog As FileDialog
Dim oFile As Scripting.File
Dim oFolder

Set oFldialog = Application.FileDialog(msoFileDialogFolderPicker)

With oFldialog
    If .Show = -1 Then
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        sFolderName = .SelectedItems(1)
    End If
End With

Set oFolder = FSO.GetFolder(sFolderName)

Workbooks.Add: Pivot = ActiveWorkbook.Name 'Destination workbook

For Each oFile In oFolder.Files
    Workbooks(Pivot).Activate

    x = Workbooks(Pivot).Sheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row + 1

    Workbooks.Open filename:=oFile: sSourceName = ActiveWorkbook.Name
    Workbooks(sSourceName).Activate
        Workbooks(sSourceName).Sheets("Sheet1").[A1:D1].Copy

    Workbooks(Pivot).Activate
    Workbooks(Pivot).Sheets("Sheet1").Cells(x, 1).PasteSpecial xlPasteAll
    Workbooks(sSourceName).Close False
Next

End Sub

---

使用宏录制器创建代码来执行一次-然后创建一些循环逻辑并查看其运行情况-在此处发布您的最终结果，并告诉我们哪里不起作用。编辑您的问题并包含您尝试过的内容（尤其是代码）。然后特别指出你遇到的问题。谢谢——我会在周末研究这个问题，看看效果如何。谢谢，我会在周末测试这个问题，看看效果如何。谢谢你的帮助。

Sub combine_into_one()
Dim FSO As Object: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim strPath$, Pivot$, sUserName$, sFolderName$, sSourceName$, x&
Dim oFldialog As FileDialog
Dim oFile As Scripting.File
Dim oFolder

Set oFldialog = Application.FileDialog(msoFileDialogFolderPicker)

With oFldialog
    If .Show = -1 Then
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        sFolderName = .SelectedItems(1)
    End If
End With

Set oFolder = FSO.GetFolder(sFolderName)

Workbooks.Add: Pivot = ActiveWorkbook.Name 'Destination workbook

For Each oFile In oFolder.Files
    Workbooks(Pivot).Activate

    x = Workbooks(Pivot).Sheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row + 1

    Workbooks.Open filename:=oFile: sSourceName = ActiveWorkbook.Name
    Workbooks(sSourceName).Activate
        Workbooks(sSourceName).Sheets("Sheet1").[A1:D1].Copy

    Workbooks(Pivot).Activate
    Workbooks(Pivot).Sheets("Sheet1").Cells(x, 1).PasteSpecial xlPasteAll
    Workbooks(sSourceName).Close False
Next

End Sub