如何用vba合并多个excel工作簿文件的内容？

将多个工作簿的内容合并到一个工作簿是一个经常会碰到的问题。

它的一般步骤是：

1.打开结果工作簿

2.遍历要合并的工作簿所在的文件夹

3.打开其中一个工作簿

4.将数据写入结果工作簿

5.关闭步骤3中打开的工作簿

6.重复步骤3-步骤5

7.调整结果工作簿的格式

8.弹出合并结束的消息

基于以上的步骤，可以使用如下的模板代码：

Sub QQ1722187970()
    Excel.Application.ScreenUpdating = False
    Excel.Application.Calculation = xlCalculationManual
    Excel.Application.DisplayAlerts = False
    '第一步获取要遍历的文件夹的路径
    Dim sPath As String
    sPath = GetPath
    If Len(sPath) Then
        '开始遍历每个文件
        Call EnuAllFiles(sPath, False)
        MsgBox "合并完成!"
    Else
        MsgBox "你没有选择文件夹!"
    End If
    
    Excel.Application.ScreenUpdating = True
    Excel.Application.Calculation = xlCalculationAutomatic
    Excel.Application.DisplayAlerts = True
End Sub
Function GetPath() As String
    '声明一个FileDialog对象变量
    Dim oFD As FileDialog
    Dim oFDFilter As FileDialogFilters
'    '创建一个选择文件对话框
'    Set oFD = Application.FileDialog(msoFileDialogFilePicker)
    '创建一个选择文件夹对话框
    Set oFD = Application.FileDialog(msoFileDialogFolderPicker)
    '声明一个变量用来存储选择的文件名
    Dim vrtSelectedItem As Variant
    With oFD
'        .Filters.Clear
'        .Filters.Add "Excel文件", "*.xls*", 1
'        .Filters.Add "Word文件", "*.doc*", 2
        '允许选择多个文件
        .AllowMultiSelect = True
        '使用Show方法显示对话框，如果单击了确定按钮则返回-1。
        If .Show = -1 Then
            '遍历所有选择的文件
            For Each vrtSelectedItem In .SelectedItems
                '获取所有选择的文件的完整路径,用于各种操作
                GetPath = vrtSelectedItem
            Next
            '如果单击了取消按钮则返回0
        Else
        End If
    End With
    '释放对象变量
    Set oFD = Nothing
End Function
Sub EnuAllFiles(ByVal sPath As String, Optional bEnuSub As Boolean = False)
    '定义文件系统对象
    Dim oFso As Object
    Set oFso = CreateObject("Scripting.FileSystemObject")
    '定义文件夹对象
        Dim oFolder As Object
    Set oFolder = oFso.GetFolder(sPath)
    '定义文件对象
    Dim oFile As Object
    '如果指定的文件夹含有文件
    If oFolder.Files.Count Then
        For Each oFile In oFolder.Files
            With oFile
                '输出文件所在的盘符
                Dim sDrive As String
                sDrive = .Drive
                '输出文件的类型
                Dim sType As String
                sType = .Type
                '输出含后缀名的文件名称
                Dim sName As String
                sName = .Name
                '输出含文件名的完整路径
                Dim sFilePath As String
                sFilePath = .Path
                '如果文件是Word文件
                If sType Like "*Excel*" Then
                    '以下是对每个文件进行处理的代码
                    '*********************************
                    Debug.Print sFilePath
                    Call UnionWorkbook(sFilePath)
                Else
                End If
            End With
        Next
    '如果指定的文件夹不含有文件
    Else
    End If
    '如果要遍历子文件夹
    If bEnuSub = True Then
        '定义子文件夹集合对象
        Dim oSubFolders As Object
        Set oSubFolders = oFolder.SubFolders
        If oSubFolders.Count > 0 Then
            For Each oTempFolder In oSubFolders
                sTempPath = oTempFolder.Path
                Call EnuAllFiles(sTempPath, True)
            Next
        End If
        Set oSubFolders = Nothing
    End If
    Set oFile = Nothing
    Set oFolder = Nothing
    Set oFso = Nothing
End Sub
'开始合并工作簿
Sub UnionWorkbook(ByVal sPath As String)
    Dim oWB As Workbook
    Dim oWk As Worksheet
    Dim oWK1 As Worksheet
    Set oWB = Excel.Workbooks.Open(sPath)
    With oWB
        For Each oWk In .Worksheets
            With oWk
                iRow = .Range("a65536").End(xlUp).Row
                sName = .Name
                Set oWK1 = Excel.ThisWorkbook.Worksheets(sName)
                iRow1 = oWK1.Range("a65536").End(xlUp).Row + 1
                .Range(.Cells(2, 1), .Cells(iRow, 256)).Cells.Copy oWK1.Range("a" & iRow1)
            End With
        Next
        .Saved = True
        .Close
    End With
End Sub