将来自不同工作簿的同名工作表合并到一个主工作簿中答案

【问题标题】：Combine Sheets from different workbooks with the same names into a master workbook将来自不同工作簿的同名工作表合并到一个主工作簿中
【发布时间】：2016-09-06 17:47:42
【问题描述】：

所以我有大约 21 张在大约 16 个文件中的名称完全相同的工作表。所有格式等都是完全相同的，因此例如我需要将所有 16 个文件中的所有带有“年龄”的工作表合并到一个主文件中，该文件将具有“年龄”工作表以及所有 16 个“年龄”的聚合数据床单。其他 20 种工作表类型也是如此。

我不确定该怎么做。我有一个宏，它当前将文件中的所有工作表一起添加到一个主工作簿中，我希望对其进行修改，以便将类似的工作表组合在一起，而不是将它们全部添加到一个工作簿中。任何想法将不胜感激！

Sub AddAllWS()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

MyPath = "C:\Documents and Settings\path\to"
Set wbDst = ThisWorkbook
strFilename = Dir(MyPath & "\*.xls", vbNormal)

If Len(strFilename) = 0 Then Exit Sub

Do Until strFilename = ""

        Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)

        Set wsSrc = wbSrc.Worksheets(1)

        wsSrc.UsedRange.Copy

        wsSrc.Paste (wbSrc.Range("A" & Rows.Count).End(xlUp).Offset(1))


        wbSrc.Close False

    strFilename = Dir()

Loop
wbDst.Worksheets(1).Delete

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

【问题讨论】：

快速浏览一下，注意您是如何在工作表中添加Range 的？您必须对Rows.Count、Columns.Count、Cells() 等执行相同的操作。否则，VBA 很快就会混淆。尝试这样做以查看它是否可以解决您的问题。（至少，它有助于收紧你的代码！）

标签： excel vba worksheet consolidation

【解决方案1】：

您似乎正在复制并粘贴到同一个源工作表中。检查下面的代码。那可能行得通。我在代码中放入了 cmets。

Sub AddAllWS()
    Dim wbDst As Workbook
    Dim wsDst As Worksheet
    Dim wbSrc As Workbook
    Dim wsSrc As Worksheet
    Dim MyPath As String
    Dim strFilename As String
    Dim lLastRow As Long

    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    Set wbDst = ThisWorkbook

    MyPath = "C:\Documents and Settings\path\to\"
    strFilename = Dir(MyPath & "*.xls*", vbNormal)

    Do While strFilename <> ""

            Set wbSrc = Workbooks.Open(MyPath & strFilename)

            'loop through each worksheet in the source file
            For Each wsSrc In wbSrc.Worksheets
                'Find the corresponding worksheet in the destination with the same name as the source
                On Error Resume Next
                Set wsDst = wbDst.Worksheets(wsSrc.Name)
                On Error GoTo 0
                If wsDst.Name = wsSrc.Name Then
                    lLastRow = wsDst.UsedRange.Rows(wsDst.UsedRange.Rows.Count).Row + 1
                    wsSrc.UsedRange.Copy
                    wsDst.Range("A" & lLastRow).PasteSpecial xlPasteValues
                End If
            Next wsSrc

            wbSrc.Close False
            strFilename = Dir()
    Loop

    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

【讨论】：