excel不同文件表格批量加表头vba_VBA宏之批量合并同一文件夹下的Excel表格

此宏解决的痛点&＃xff1a;

多个表格字段相同&＃xff0c;需要手工一个个打开之后复制合并到一个表上面的难题。

宏使用方式&＃xff1a;

如下代码贴到VBE编辑器里后&＃xff0c;不需任何修改即可直接使用。使用前确保要合并的Excel放置在同一个文件夹内&＃xff0c;点击宏后&＃xff0c;把存放Excel的文件夹的地址粘贴到弹出框即可。

示例&＃xff1a;

1、待合并的EXCEL放在同一个文件夹内

2、使用宏&＃xff0c;粘贴路径地址

3、大功告成

如下为代码

Sub 合并指定文件夹的工作簿()

Dim MP, MN, AW, Wbn, wn

Dim Wb As Workbook

Dim i, a, b, c, d, e

Application.ScreenUpdating &＃61; False

MP &＃61; InputBox("请输入需要合并的文件夹的地址&＃xff0c;如D:\")

Workbooks.Add

&＃39;遍历地址下所有拓展名含xls的文件

MN &＃61; Dir(MP & "\" & "*.xls*")

&＃39;获取当前工作簿名称

Num &＃61; 0

e &＃61; 1

&＃39;一个一个的打开工作簿&＃xff0c;只要打开了&＃xff0c;就执行以下的命令

Do While MN <> ""

&＃39;如果工作簿和汇总的表格名称不一致&＃xff0c;则执行以下的命令

If MN <> AW Then

Set Wb &＃61; Workbooks.Open(MP & "\" & MN)

&＃39;计数现在汇总了几张表

a &＃61; a &＃43; 1

With Workbooks(AW).ActiveSheet

&＃39;确定当前工作簿有多少个工作表&＃xff0c;一个一个的打开

For i &＃61; 1 To Sheets.Count

&＃39;如果工作表的A1单元格不为空&＃xff0c;则执行如下语句

If Sheets(i).Range("A1") <> "" Then

&＃39;复制首行/表头

Wb.Sheets(i).Range("A1").Resize(1, Sheets(i).UsedRange.Columns.Count).Copy .Cells(1, 1)

&＃39;确定待复制的工作表总共有多少列

d &＃61; Wb.Sheets(i).UsedRange.Columns.Count

&＃39;确定待复制的工作表剔除表头有多少行

c &＃61; Wb.Sheets(i).UsedRange.Rows.Count - 1

&＃39;增加一列填入工作簿&工作表名

wn &＃61; Wb.Sheets(i).Name

.Cells(1, d &＃43; 1) &＃61; "表名"

.Cells(e &＃43; 1, d &＃43; 1).Resize(c, 1) &＃61; MN & wn

e &＃61; e &＃43; c

&＃39;复制表格信息到汇总表里

Wb.Sheets(i).Range("A2").Resize(c, d).Copy .Cells(.Range("A1048576").End(xlUp).Row &＃43; 1, 1)

End If

Next

&＃39;将刚打开的表格名和前面已汇总过的表格名组合起来

Wbn &＃61; Wbn & Chr(13) & Wb.Name

&＃39;关闭当前工作簿

Wb.Close False

End With

End If

MN &＃61; Dir

&＃39;循环

Loop

Range("A1").Select

Application.ScreenUpdating &＃61; True

MsgBox "共合并了" & a & "个工作簿下全部工作表。明细如下&＃xff1a;" & Chr(13) & Wbn, vbInformation, "提示"

End Sub