使用VBA合并多个Excel工作簿

有许多实现Excel工作簿合并的方法，在《将多个工作簿中的数据合并到一个工作簿》中介绍过合并工作簿的示例。下面再列举几个示例，供有兴趣的朋友参考。
例如，需要将多个Excel工作簿中的工作表合并到一个工作簿。这里假设需要合并的工作簿在“D:/示例/数据记录/”文件夹中，含有两个工作簿test1.xls、test2.xls（当然，可以不限于两个），在test1.xls工作簿中含有三张工作表，在test2.xls工作簿中含有两张工作表，现在使用一段VBA代码合并这两个工作簿到一个新工作簿中，合并到新工作簿中的工作表分别以原工作簿名加索引值命名。代码如下：

Sub CombineWorkbooks()
    Dim strFileName As String
    Dim wb As Workbook
    Dim ws As Object
 
    '包含工作簿的文件夹,可根据实际修改
    Const strFileDir As String = "D:/示例/数据记录/"
 
    Application.ScreenUpdating = False
 
    Set wb = Workbooks.Add(xlWorksheet)
    strFileName = Dir(strFileDir & "*.xls*")
 
    Do While strFileName <> vbNullString
        Dim wbOrig As Workbook
        Set wbOrig = Workbooks.Open(Filename:=strFileDir & strFileName, ReadOnly:=True)
        strFileName = Left(Left(strFileName, Len(strFileName) - 4), 29)
 
        For Each ws In wbOrig.Sheets
            ws.Copy After:=wb.Sheets(wb.Sheets.Count)
            If wbOrig.Sheets.Count > 1 Then
                wb.Sheets(wb.Sheets.Count).Name = strFileName & ws.Index
            Else
                wb.Sheets(wb.Sheets.Count).Name = strFileName
            End If
        Next
 
        wbOrig.Close SaveChanges:=False
 
        strFileName = Dir
 
    Loop
 
    Application.DisplayAlerts = False
    wb.Sheets(1).Delete
    Application.DisplayAlerts = True
 
    Application.ScreenUpdating = True
 
    Set wb = Nothing
 
End Sub

示例文档下载：

下面是合并多个Excel工作簿的另一种情形，也是《Excel VBA实战技巧精粹》中<技巧91：汇总多个工作簿的工作表>所介绍的方法，即合并汇总。
有四个工作簿，分别为：汇总工作簿.xls、一月.xls、二月.xls、三月.xls，其中一月.xls、二月.xls、三月.xls均只含有一张工作表且工作表中的数据均自单元格A1开始，现在要求将它们合并至“汇总工作簿.xls”中。
在“汇总工作簿.xls”中打开VBE，并输入下列代码：

Sub ConsolidateWorkbook()
    Dim RangeArray() As String
    Dim bk As Workbook
    Dim sht As Worksheet
    Dim WbCount As Integer
    WbCount = Workbooks.Count
    ReDim RangeArray(1 To WbCount - 1)
    For Each bk In Workbooks '在所有工作簿中循环
        If Not bk Is ThisWorkbook Then '非代码所在工作簿
            Set sht = bk.Worksheets(1) '引用工作簿的第一个工作表
            i = i + 1
            RangeArray(i) = "'[" & bk.Name & "]" & sht.Name & "'!" & _
                sht.Range("A1").CurrentRegion.Address(ReferenceStyle:=xlR1C1)
        End If
    Next
    Worksheets(1).Range("A1").Consolidate _
                  RangeArray, xlSum, True, True
End Sub

运行上述代码前，必须打开所有的工作簿。运行代码后，将自动汇总所有工作表中的值并将相应单元格的值求和。
示例文档下载：


下面是汇总多个工作簿的又一种情形，也是一名网友提出的问题：在同一文件夹中有多个工作簿，其中有一个用于汇总的工作簿，要求将除该汇总工作簿外的其它工作簿中的第一张工作表的数据汇总到该汇总工作簿中。代码如下：

Sub UnionWorksheets()
    Application.ScreenUpdating = False
    Dim lj As String
    Dim dirname As String
    Dim nm As String
 
    lj = ActiveWorkbook.Path
    nm = ActiveWorkbook.Name
    dirname = Dir(lj & "/*.xls*")
 
    Cells.Clear
 
    Do While dirname <> ""
        If dirname <> nm Then
            Workbooks.Open Filename:=lj & "/" & dirname
 
            Workbooks(nm).Activate
 
            '复制新打开工作簿的第一个工作表的已用区域到当前工作表
            Workbooks(dirname).Sheets(1).UsedRange.Copy _
                Range("A65536").End(xlUp).Offset(1, 0)
 
            Workbooks(dirname).Close False
        End If
        dirname = Dir
    Loop
 
End Sub

还一个相当于菜单中的“合并计算”，不过是用VBA实现的

Sub Macro1()
Dim w, wknm$
wknm = ThisWorkbook.Name
w = Array("'[" & wknm & "]数据表1'!" & Application.ConvertFormula(Sheet1.UsedRange.Address, xlA1, xlR1C1, 1), "'[" & wknm & "]数据表2'!" & Application.ConvertFormula(Sheet2.UsedRange.Address, xlA1, xlR1C1, 1)) 
With Sheet3
    .UsedRange.Clear
    .[a1].Consolidate w, xlSum, 1, 1
    [a1] = Sheet1.[a1]
End With
End Sub