VBA實現批量合並多個Excel數據

場景描述：接上一篇文章，我用Python把數據導出來后，需要把多個Excel的數據合並到一個表里面；

前提條件：1.每個工作簿的列標題及列數要一致；

　　　　　2.每個工作簿的頁簽名稱要一致；

　　　　　3.保證該路徑下只存在Excel文件；

　　　　　若不滿足以上條件，可能會數據混亂；

實現邏輯：用vba自動訪問該路徑下的工作簿；然后把里面指定的數據拿出來放到當前活動的工作簿內，然后關閉已打開的工作簿；

'合並多個Excel表數據
Sub MergeExcel()
    Dim WbookPath, WbookName, AWbookName
    Dim Wb As Workbook, WbN As String
    Dim i As Long
    Dim Num As Long
    Dim BOX As String
    Application.ScreenUpdating = False'關閉屏幕刷新
    WbookPath = ActiveWorkbook.Path'獲取當前打開的工作簿的路徑
    WbookName = Dir(WbookPath & "\" & "*.xls")'獲取后綴為.xls的文件，默認為該路徑第一個文件
    AWbookName = ActiveWorkbook.Name'獲取活動工作簿的名稱
    Num = 0
    'MsgBox "WbookPath:" & WbookPath
    'MsgBox "WbookName:" & WbookName
    'MsgBox "AWbookName:" & AWbookName
    Do While WbookName <> "" '如果獲取到的文件名稱不為空，進入循環
        If WbookName <> AWbookName Then    'if判斷名稱是否為當前活動工作簿，為true則繼續執行if內代碼塊
            If WbookName = "輔助核算對照信息1.xls" Then'如果工作簿名稱是這個，就保留表頭信息，否則不保留表頭
                Set Wb = Workbooks.Open(WbookPath & "\" & WbookName)'打開該路徑下的文件
                Num = Num + 1
                With Workbooks(1).ActiveSheet
                .Cells(.Range("B165536").End(xlUp).Row + 2, 1) = Left(WbookName, Len(WbookName) - 4)'在當前工作薄中B列最后有數據的單元格后2格加上合並文件名不包含擴展名
                For i = 1 To Sheets.Count
                    Wb.Sheets(i).UsedRange.Copy .Cells(.Range("B165536").End(xlUp).Row, 1)'把當前工作簿路徑下的xls文件中的Sheets(i)頁簽下的數據復制到當前工作薄中的B列最后有數據的單元格，列為第一列（即A列）
                Next
                WbN = WbN & Chr(13) & Wb.Name
                Wb.Close False
                End With
            Else
                Set Wb = Workbooks.Open(WbookPath & "\" & WbookName)
                Num = Num + 1
                With Workbooks(1).ActiveSheet
                .Cells(.Range("B165536").End(xlUp).Row + 2, 1) = Left(WbookName, Len(WbookName) - 4)
                For i = 1 To Sheets.Count
                    Wb.Sheets(i).UsedRange.Offset(3).Copy .Cells(.Range("B165536").End(xlUp).Row + 1, 1)'.Offset(3)，不復制前三行
                Next
                WbN = WbN & Chr(13) & Wb.Name
                Wb.Close False
                End With
            End if
        End If
        WbookName = Dir'查找下一個文件,如果下一個文件不是xls會報錯
    Loop
    Range("B1").Select
    Application.ScreenUpdating = True
    MsgBox "已合並" & Num & "個工作薄，列表如下：" & Chr(13) & WbN, vbInformation
End Sub

 

具體操作方法：

1.如下圖，前面四個文件是需要合並的表，最后一個是合並后存放數據的表；

 

 

2.我們打開匯總表，在第一個頁簽上右鍵點擊查看代碼；

 

 

3.然后把上面的代碼復制進去（需要根據自己需要修改代碼內的數據），需要修改的地方都有注釋是什么意思什么作用的，最后點擊運行，即可完成匯總；

匯總之后記得保存數據，如果提示不能保存帶有宏的文件，就選擇另存為即可；