简单粗暴-将多个excel汇总到一个excel的sheet

首先将待合并的excel都放到一个文件目录下

新建一个excel右键sheet查看代码 复制如下代码

Sub Macro1()
Dim MyPath$, MyName$, sh As Worksheet, sht As Worksheet, m&
Set sh = ActiveSheet
MyPath = ThisWorkbook.Path & "\"
MyName = Dir(MyPath & "*.xlsx")
Application.ScreenUpdating = False
Cells.ClearContents
Do While MyName <> ""
If MyName <> ThisWorkbook.Name Then
With GetObject(MyPath & MyName)
For Each sht In .Sheets
If IsSheetEmpty = IsEmpty(sht.UsedRange) Then
m = m + 1
If m = 1 Then
sht.[a1].CurrentRegion.Copy sh.[a1]
Else
sht.[a1].CurrentRegion.Offset(1).Copy sh.[a65536].End(xlUp).Offset(1) '这种写法只保留第一个文件的表头
'sht.[a1].CurrentRegion.Copy sh.[a65536].End(xlUp).Offset(1) 这种会提取所有行信息
'2007版及以后可以改成a1048576 但不建议，最好取多个文件有值的最大行数

End If
End If
Next
.Close False
End With
End If
MyName = Dir
Loop
Application.ScreenUpdating = True
MsgBox "当前工作簿下的全部工作表已经合并完毕！", vbInformation, "提示"
End Sub

参考如下并整理

作者: 知乎用户
链接：https://www.zhihu.com/question/20366713/answer/109112356
来源: 知乎