extjs3.4表头合并行_VBA宏之批量合并同一文件夹下的Excel表格

此宏解决的痛点：

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

宏使用方式：

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

示例：

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

2、使用宏，粘贴路径地址

3、大功告成

如下为代码

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

Dim MP, MN, AW, Wbn, wn

Dim Wb As Workbook

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

Application.ScreenUpdating = False

MP = InputBox("请输入需要合并的文件夹的地址，如D:")

Workbooks.Add

'遍历地址下所有拓展名含xls的文件

MN = Dir(MP & "" & "*.xls*")

'获取当前工作簿名称

AW = ActiveWorkbook.Name

Num = 0

e = 1

'一个一个的打开工作簿，只要打开了，就执行以下的命令

Do While MN <> ""

'如果工作簿和汇总的表格名称不一致，则执行以下的命令

If MN <> AW Then

Set Wb = Workbooks.Open(MP & "" & MN)

'计数现在汇总了几张表

a = a + 1

With Workbooks(AW).ActiveSheet

'确定当前工作簿有多少个工作表，一个一个的打开

For i = 1 To Sheets.Count

'如果工作表的A1单元格不为空，则执行如下语句

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

'复制首行/表头

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

'确定待复制的工作表总共有多少列

d = Wb.Sheets(i).UsedRange.Columns.Count

'确定待复制的工作表剔除表头有多少行

c = Wb.Sheets(i).UsedRange.Rows.Count - 1

'增加一列填入工作簿&工作表名

wn = Wb.Sheets(i).Name

.Cells(1, d + 1) = "表名"

.Cells(e + 1, d + 1).Resize(c, 1) = MN & wn

e = e + c

'复制表格信息到汇总表里

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

End If

Next

'将刚打开的表格名和前面已汇总过的表格名组合起来

Wbn = Wbn & Chr(13) & Wb.Name

'关闭当前工作簿

Wb.Close False

End With

End If

MN = Dir

'循环

Loop

Range("A1").Select

Application.ScreenUpdating = True

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

End Sub