将多个工作簿中的多个工作表合并为一个具有相同工作表的工作簿，但将合并多个工作表中的数据

Question

我尝试在网络上查找此内容，但出于我的目的，到目前为止我无法优化所需的代码。这就是我想要完成的：

我有名为 Excel 1、Excel 2、Excel 3 和 Master Excel 的文件。当涉及到标题等时，所有文件都具有相同数量的工作表、工作表名称和相同的结构。

我正在尝试将 Excel 1、Excel 2 和 Excel 3 的值合并到主文件中。

所以在主文件上，如果有名为 1000 的工作表，则从名为 1000 的 Excel 1 工作表中复制粘贴一个范围。然后在 Excel 2 中查找工作表 1000，并在最后一行之后的空白行上复制粘贴一个范围用于主文件 Sheet 1000。

范围始终是标题之后的行（这在所有工作表上都是固定的），直到包含特定列数据的最后一行。

现在每个工作簿中有多个工作表，所有工作表都将具有相同的名称。

文件的文件路径也是不变的，所以我不想选择一个选项。

下面的代码能够遍历工作表，我也可以完美地定义复制粘贴范围，但唯一的问题是我不知道如何将目标工作表与目标工作表相匹配，这意味着 Excel 中的工作表 1000 的数据将 1 个文件粘贴到主文件中的第 1000 页。

Sub test()

Dim MyFile As String, MyFiles As String, FilePath As String
Dim erow As Long
'~~> Put additional variable declaration
Dim wbMaster As Workbook, wbTemp As Workbook
Dim wsMaster As Worksheet, wsTemp As Worksheet

FilePath = "\\AM01PCIFS01.global.root\HomeDirs$\yameen.sarwar\Desktop\Test\II1\"
MyFiles = "\\AM01PCIFS01.global.root\HomeDirs$\yameen.sarwar\Desktop\Test\II1\*.xlsx"
MyFile = Dir(MyFiles)

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

'~~> Set your declared variables
Set wbMaster = ThisWorkbook 'if you want to consolidate files in this workbook
Set wsMaster = wbMaster.Sheets("Sheet1") 'replace Sheet1 to suit

Do While Len(MyFile) > 0
    'Debug.Print MyFile
    If MyFile <> "master.xlsm" Then
        '~~> Open the file and at the same time, set your variable
        Set wbTemp = Workbooks.Open(Filename:=FilePath & MyFile, ReadOnly:=True)
        Set wsTemp = wbTemp.Sheets(1) 'I used index, you said there is only 1 sheet
        '~~> Now directly work on your object
        With wsMaster
            erow = .Range("A" & .Rows.Count).End(xlUp).Row 'get the last row
            '~~> Copy from the file you opened
            wsTemp.Range("A2:S20").Copy 'you said this is fixed as well
            '~~> Paste on your master sheet
            .Range("A" & erow).Offset(1, 0).PasteSpecial xlPasteValues
        End With
        '~~> Close the opened file
        wbTemp.Close False 'set to false, because we opened it as read-only
        Set wsTemp = Nothing
        Set wbTemp = Nothing
    End If
    '~~> Load the new file
    MyFile = Dir
Loop

With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
End With

End Sub

Answer 1

试试这个（在代码中查看我的 cmets），但我在你的 Do While 循环中做了一些小改动

Sub test()

Dim MyFile As String, MyFiles As String, FilePath As String
Dim erow As Long
'~~> Put additional variable declaration
Dim wbMaster As Workbook, wbTemp As Workbook
Dim wsMaster As Worksheet, wsTemp As Worksheet
Dim i As Integer

FilePath = "\\AM01PCIFS01.global.root\HomeDirs$\yameen.sarwar\Desktop\Test\II1\"
MyFiles = "\\AM01PCIFS01.global.root\HomeDirs$\yameen.sarwar\Desktop\Test\II1\*.xlsx"
MyFile = Dir(MyFiles)

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

'~~> Set your declared variables
Set wbMaster = ThisWorkbook 'if you want to consolidate files in this workbook

Do While Len(MyFile) > 0
    'Debug.Print MyFile
    If MyFile <> "master.xlsm" Then
        '~~> Open the file and at the same time, set your variable
        Set wbTemp = Workbooks.Open(Filename:=FilePath & MyFile, ReadOnly:=True)
        'Start the loop of sheets within the source workbook
        For i = 1 To wbTemp.Sheets.Count
            Set wsTemp = wbTemp.Sheets(i) 'I used index, you said there is only 1 sheet
            '~~> Now directly work on your object
            With wbMaster.Worksheets(wsTemp.Name) 'This matches the sheet name in the source workbook to the sheet name in the target workbook
                erow = .Range("A" & .Rows.Count).End(xlUp).Row 'get the last row of target sheet
                '~~> Copy from the file you opened
                wsTemp.Range("A2:S20").Copy 'you said this is fixed as well
                '~~> Paste on your master sheet
                .Range("A" & erow).Offset(1, 0).PasteSpecial xlPasteValues
                Application.CutCopyMode = False
            End With
        Next i
        '~~> Close the opened file
        wbTemp.Close False 'set to false, because we opened it as read-only
    End If
    '~~> Load the new file
    MyFile = Dir
Loop

With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
End With

End Sub

Answer 2

要在 wbMaster 中获取工作表名称并在 wbTemp 中引用具有相同名称的工作表，您可以通过变量传递名称。这里有几行将遍历 wbMaster 中的工作表

Dim strSheetname as String

For i = 1 To wbMaster.Sheets.Count
      strSheetName = wbMaster.Sheets(i).Name
      Set wsTemp = wbTemp.Sheets(strSheetName)
      'Do whatever you need here with wsTemp
Next i

此代码缺少错误处理（即，如果 wbMaster 中存在 wbTemp 中不存在的工作表，您将收到超出范围的错误），但这将帮助您开始。