vba：合并excel

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



 1     Dim Workbook As Workbook
 2     Dim copyRange As Range
 3     Dim i As LongPtr
 4     Dim num As LongPtr
 5     Dim box As String
 6     Dim headerCount As Integer
 7     
 8     headerCount = 1 ' 表头行数，根据实际情况设置
 9     Application.ScreenUpdating = False
10     filePath = ThisWorkbook.Path
11     fileName = Dir(filePath & "" & "*.xls")
12     mergedWorkbookName = ThisWorkbook.Name
13     num = 0 '填入从第几行开始即可跳过表头合并，如果表头为一行，num = 1则跳过表头合并，num = 0表示保留一个表头
14     
15     Do While fileName <> ""
16         If fileName <> mergedWorkbookName Then
17             Set Workbook = Workbooks.Open(filePath & "" & fileName)
18             num = num + 1
19             With ThisWorkbook.ActiveSheet
20                 ' .Cells(.Range("A65535").End(xlUp).Row + 2, 1).Value = Left(fileName, Len(fileName) - 5)
21                 For i = 1 To Workbook.Sheets.Count
22                     If num = 1 And i = 1 Then
23                         Workbook.Sheets(i).UsedRange.Copy .Cells(1, 1)
24                     Else
25                         Set copyRange = Workbook.Sheets(i).UsedRange
26                         copyRange.Offset(headerCount, 0).Resize(copyRange.Rows.Count - headerCount, copyRange.Columns.Count).Copy .Cells(.Range("A65535").End(xlUp).Row + 1, 1)
27                     End If
28                 Next
29             End With
30             processedFileNames = processedFileNames & Chr(13) & Workbook.Name
31             Workbook.Close False
32         End If
33         fileName = Dir()
34     Loop
35     UsedRange.Columns.AutoFit
36     Range("A1").Select
37     Application.ScreenUpdating = True
38     MsgBox "共合并了" & num & "个工作薄下的全部工作表。文件名如下：" & processedFileNames, vbInformation, "提示"
39 End Sub