vba合并指定文件夹的所有excel文件

请教一下如何合并指定文件夹的所有excel文件,每个excel文件数据不等
比如文件夹里有三个文件

img

每个文件的表头一样,下图仅为示例:

img

要合并成下面这样

img

录制一个宏,记录下你打开文件,选中,复制,粘贴的步骤,基本就有了
然后再加上一个获取指定文件夹下文件的方法,取得文件列表,循环一下就成了

Sub Dan()
    ' 主程序
    Dim filepaths$
    Dim a, arrfile, Arr
    Dim Wkb As Workbook, Sht As Worksheet
    Dim theWkb As Workbook, theSht As Worksheet
    Dim endRow%, i%, j%
    
    Call deleteAllOthers
    filepaths = getCurFiles()
    arrfile = Split(filepaths, "|")
    Set theWkb = ThisWorkbook
    Set theSht = Sheet1
    For Each a In arrfile
        Set Wkb = Workbooks.Open(a)
        For Each Sht In Wkb.Sheets
            If Sht.Name = "目录" Or Sht.Name = "汇总" Then
                Arr = Sht.UsedRange
                With theSht
                    For i = 3 To UBound(Arr)
                        If Len(Arr(i, 1)) > 0 Then
                            endRow = .Cells(.Rows.Count, 1).End(3).Row + 1
                            For j = LBound(Arr, 2) To 6
                                .Cells(endRow, j).Value = Arr(i, j)
                            Next
                        End If
                    Next
                End With
            Else
                Sht.Copy after:=theSht
            End If
        Next
        Wkb.Close 0
    Next
End Sub

Function getCurFiles() As String()
    ' 获取当前文件夹所有文件
    Dim Folder$, Filename$, Filepath$, filepaths(), arrCount%
    Folder = "D:\OneDrive\桌面\隽悦雅苑\"
    Filename = Dir(Folder)
    While Filename <> ""
        If Filename <> ThisWorkbook.Name Then
            ReDim Preserve filepaths(0 To arrCount)
            Filepath = Folder + Filename
            filepaths(arrCount) = Filepath
            arrCount = arrCount + 1
        End If
        Filename = Dir
    Wend
    getCurFiles = Join(filepaths, "|")
End Function

Sub deleteAllOthers()
    ' 在当前工作簿删除除了汇总以外的所有其他表
    Dim Sht As Worksheet
    On Error Resume Next
    For Each Sht In ThisWorkbook.Sheets
        If Sht.Name <> Sheet1.Name Then
            Sht.Delete
        End If
    Next
    Debug.Print "All Deleted"
End Sub

Sub test()
     x = getCurFiles
     Debug.Print x
End Sub