EXCEL VBA 合并多张相同格式的工作表的宏
不熟悉VBA的可以直接下载使用：下载打包的宏文件
熟悉VBA的可以拷贝我的代码文件自行粘贴或修改以进一步使用：
'时间：2018/7/13周四
'作者：Neil
'
Sub 表合并()
Dim arr(200) As Long #用于统计表数
Dim str_arr(200) As String #用于计录文件名
Dim i, n, n_f, r_i, c_i As Long
file_path = ActiveWorkbook.Path + "\excel_files\"
this_path = ActiveWorkbook.Name
i = 0
n = 0
n_f = 0
r_i = 0
c_i = 0
f = Dir(file_path)
While f <> ""
f_h = Left(f, 1)
If f_h <> "~" Then
Workbooks.Open (file_path + f)
Windows(f).Activate
ActiveWorkbook.Sheets(1).Select
Range("A1").CurrentRegion.Select
r_i = Selection.Rows.Count
c_i = Selection.Columns.Count
If i = 0 Then
Range(Cells(1, 1), Cells(r_i, c_i)).Select
Selection.Copy
Else
Range(Cells(2, 1), Cells(r_i, c_i)).Select
Selection.Copy
End If
n_f = n_f + 1
Debug.Print i
Debug.Print r_i
arr(i) = r_i - 1
str_arr(i) = f
Windows(this_path).Activate
Sheets(Sheets.Count).Activate
Range(Cells(n + 1, 1), Cells(n + r_i, c_i)).Select
ActiveSheet.Paste
ActiveSheet.Columns.AutoFit
Range("A1").Activate
If i = 0 Then
n = n + r_i
Else
n = n + r_i - 1
End If
i = i + 1
End If
f = Dir
Wend
Windows(this_path).Activate
Cells(1, 1).Activate
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Select
Range("A1") = "file_name"
Range("B1") = "number"
i = 0
While i < n_f
Cells(i + 1, "A") = str_arr(i)
Cells(i + 1, "B") = arr(i)
i = i + 1
Wend
Cells(n_f + 1, "A") = "共 " + Str(n_f) + " 个文件"
Cells(n_f + 1, "B") = "共 " + Str(n - 1) + " 行"
ActiveSheet.Columns.AutoFit
Range("A1").Activate
End Sub