合并当前文件夹下的所有Excel文件（VBA版）

问题很多，解决的方法很多，对于合并当前文件夹下的所有Excel文件，我之前分享是使用Python的第三方库Pandas来解决的。

“人生苦短，我用Python”说的就是Python简洁高效的特点。当然即便是每天跟数据打交道的人，也不一定人人都会Python，这里我再分享一种通用一点的方法，使用Excel自带的VBA。

还拿上次需要合并的各班级成绩Excel表为例，在需要合并Excel工作表的文件夹中新建一个Excel文件，命名为“合并.xlsx”，打开该文件，在Visual Basic编辑器中插入模块，将下面的VBA代码粘贴进去。

Sub 合并()
    Dim MyPath, MyName, AWbName
    Dim Wb As Workbook, WbN As String
    Dim i As Long
    Dim Num As Long
    Dim BOX As String

    Application.ScreenUpdating = False '关闭屏幕更新
    MyPath = ActiveWorkbook.Path '获取当前工作簿的文件位置

    '获取文件夹下的所有以“.xls”结尾的文件，根据实际情况可改成“.xlsx”
    MyName = Dir(MyPath & "\" & "*.xls")
    AWbName = ActiveWorkbook.Name '获取当前工作簿的名称
    Num = 0

    Do While MyName <> ""
        If MyName <> AWbName Then
            Set Wb = Workbooks.Open(MyPath & "\" & MyName)
            Num = Num + 1
            With Workbooks(1).ActiveSheet
                '写入Excel文件名，如果文件为“.xlsx”格式，这里的“减 4”改为“减 5”
                .Cells(.Range("A65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
                
                '写入Excel文件内容
                For i = 1 To Wb.Sheets.Count
                    Wb.Sheets(i).UsedRange.Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
                Next
                WbN = WbN & Chr(13) & Wb.Name
                Wb.Close False
            End With
        End If
        MyName = Dir
    Loop

    Range("A1").Select
    Application.ScreenUpdating = True '恢复屏幕更新
    MsgBox "共合并了" & Num & "个工作簿。如下：" & Chr(13) & WbN, vbInformation, "提示"
End Sub

运行宏，即可得到合并后的结果：