vba：合并excel

在目标文件夹新建一个excel，然后插入宏运行。



 1     Dim Workbook As Workbook
    Dim copyRange As Range
    Dim i As LongPtr
    Dim num As LongPtr
    Dim box As String
    Dim headerCount As Integer
    
    headerCount = 1 ' 表头行数，根据实际情况设置
    Application.ScreenUpdating = False
    filePath = ThisWorkbook.Path
    fileName = Dir(filePath & "" & "*.xls")
    mergedWorkbookName = ThisWorkbook.Name
    num = 0 '填入从第几行开始即可跳过表头合并，如果表头为一行，num = 1则跳过表头合并，num = 0表示保留一个表头
    
    Do While fileName <> ""
        If fileName <> mergedWorkbookName Then
            Set Workbook = Workbooks.Open(filePath & "" & fileName)
            num = num + 1
            With ThisWorkbook.ActiveSheet
                ' .Cells(.Range("A65535").End(xlUp).Row + 2, 1).Value = Left(fileName, Len(fileName) - 5)
                For i = 1 To Workbook.Sheets.Count
                    If num = 1 And i = 1 Then
                        Workbook.Sheets(i).UsedRange.Copy .Cells(1, 1)
                    Else
                        Set copyRange = Workbook.Sheets(i).UsedRange
                        copyRange.Offset(headerCount, 0).Resize(copyRange.Rows.Count - headerCount, copyRange.Columns.Count).Copy .Cells(.Range("A65535").End(xlUp).Row + 1, 1)
                    End If
                Next
            End With
            processedFileNames = processedFileNames & Chr(13) & Workbook.Name
            Workbook.Close False
        End If
        fileName = Dir()
    Loop
    UsedRange.Columns.AutoFit
    Range("A1").Select
    Application.ScreenUpdating = True
    MsgBox "共合并了" & num & "个工作薄下的全部工作表。文件名如下：" & processedFileNames, vbInformation, "提示"
End Sub