多表合并，你要的全在这里了，收藏好了！

时不时就有同学在问，一个工作簿中每天一份报表，一个月下来30份报表需要汇总成一张表，复制粘贴来的比较慢，还有的是有很多个格式一样的表位于不同的工作簿中，需要合并到一个工作表里，等等……

你可以到本公众号后台回复excel扩展，去下载小工具，里面有多表合并功能，也可以利用数据查询功能合并。

今天我们来讲讲利用VBA实现多表合并的技巧，大家可以把代码收藏好，使用的时候非常的方便。

1

工作簿内多个sheet合并到一个sheet

上边动图中有1、2、3、4，4个sheet，分别是不同部门的人员信息，需要合并到汇总sheet里。

步骤：

右键点击汇总sheet表名，查看代码，把代码复制进去，点击运行，很快就可以看到合并后的结果了。

代码如下：

Sub 合并当前工作簿下的所有工作表()

Application.ScreenUpdating = False

For j = 1 To Sheets.Count

   If Sheets(j).Name <> ActiveSheet.Name Then

       X = Range('A65536').End(xlUp).Row 1

       Sheets(j).UsedRange.Copy Cells(X, 1)

   End If

Next

Range('B1').Select

Application.ScreenUpdating = True

MsgBox '当前工作簿下的全部工作表已经合并完毕！', vbInformation, '提示'

End Sub

2

多个工作簿中的sheet合并到一个sheet

大家仔细观察，工作簿1中有两个sheet，合并的时候都会合并进去。

代码如下：

Sub 合并当前目录下所有工作簿的全部工作表()

Dim MyPath, MyName, AWbName

Dim Wb As Workbook, WbN As String

Dim G As Long

Dim Num As Long

Dim BOX As String

Application.ScreenUpdating = False

MyPath = ActiveWorkbook.Path

MyName = Dir(MyPath & '\' & '*.xlsx')

AWbName = ActiveWorkbook.Name

Num = 0

Do While MyName <> ''

If MyName <> AWbName Then

Set Wb = Workbooks.Open(MyPath & '\' & MyName)

Num = Num 1

With Workbooks(1).ActiveSheet

.Cells(.Range('B65536').End(xlUp).Row 2, 1) = Left(MyName, Len(MyName) - 4)

For G = 1 To Sheets.Count

Wb.Sheets(G).UsedRange.Copy .Cells(.Range('B65536').End(xlUp).Row 1, 1)

Next

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

Wb.Close False

End With

End If

MyName = Dir

Loop

Range('B1').Select

Application.ScreenUpdating = True

MsgBox '共合并了' & Num & '个工作薄下的全部工作表。如下：' & Chr(13) & WbN, vbInformation, '提示'

End Sub

注意代码红色字体部分，根据自己的版本更改。

3

多个工作簿中的sheet1合并到新的工作簿中

多个工作簿中的表合并到一个工作簿中，不进行汇总，只是放到一个工作簿，保留原来的表名。

代码如下：

Sub 汇总数据()

Application.ScreenUpdating = False

 Dim wb, wb1 As Excel.Workbook

Dim sh As Excel.Worksheet

s = Split(ThisWorkbook.Name, '.')(1)

f = Dir(ThisWorkbook.Path & '\*' & s) '生成查找EXCEL的目录

Do While f <> '' '在目录中循环

If f <> ThisWorkbook.Name Then  '如果不是打开的工作簿

Set wb = Workbooks.Open(ThisWorkbook.Path & '\' & f)

wb.Worksheets('sheet1').Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)

ActiveSheet.Name = Split(wb.Name, '.')(0)

    wb.Close

    End If

    f = Dir

    Loop

ThisWorkbook.Worksheets('汇总').Activate

    Application.ScreenUpdating = True

End Sub

三种情况下的合并全在此了，不需要懂得VBA，只要复制上面代码运行下就OK了，方便吧！