使用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