如何用VBA快速搞定多个工作簿合并成1个工作簿？
1、首先将要合并的工作簿放在同一个文件夹内；
2、新建一个excel，命名为合并工作簿模板。单击开发工具——插入按钮，命名为：合并工作簿，输入代码：
Sub 合并工作簿()
Dim Wb As Workbook, MyPath As String, File, Sh_n As String
Application.ScreenUpdating = False
Rem 关闭屏幕刷新
MyPath$ = ThisWorkbook.Path & "\"
Rem 获取当前工作簿路径
File = Dir(MyPath & "*.xls*")
Rem 获取路径下所有Excel文件
Do While File <> "" '遍历所有文件
If File <> ThisWorkbook.Name Then '不合并当前工作簿
Set Wb = Workbooks.Open(MyPath & File)
Rem 依次打开工作簿
Sh_n = StrReverse(Mid(StrReverse(Wb.Name), InStr(StrReverse(Wb.Name), ".") + 1))
Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = Sh_n
Rem 将第一个表复制到当前工作簿的最后一个工作表
Wb.Close False '关闭工作簿 不保存
End If
File = Dir
Rem 循环下一个工作簿
Loop
Application.ScreenUpdating = False
Rem 打开屏幕刷
End Sub
多个sheet合并成一个sheet
Sub hb()
Dim bt, i, r, c, n, first As Long
bt = 1 '表头行数，多行改为对应数值
Cells.Clear
For i = 1 To Sheets.Count
If Sheets(i).Name <> ActiveSheet.Name Then '务必当前在新建的空白页面中
If first = 0 Then
c = Sheets(i).Cells(1, Columns.Count).End(xlToLeft).Column '获取字段数https://www.cnblogs.com/acetaohai123/p/6505447.html
Sheets(i).Range("A1").Resize(bt, c).Copy Range("A1") '拷贝第一行,也就是head line
n = bt + 1: first = 1
End If
r = Sheets(i).Cells(Rows.Count, "A").End(xlUp).Row '获取要拷贝的sheet的行数
Sheets(i).Range("A" & bt + 1).Resize(r - 1, c).Copy Range("A" & n) '拷贝当前sheet中的数据到第N行
n = n + r - bt '更新行数变量n
End If
Next
End Sub