vba批量合并指定的sheet_多表合并代码，你值得拥有！

我的目标：让中国的大学生走出校门的那一刻就已经具备这些office技能，让职场人士能高效使用office为其服务。支持我，也为自己加油！

时不时有同学问，一个工作簿中每天一份报表，一个月下来30份报表需要汇总成一张表，每个月都要复制，粘贴，复制，粘贴…… 还有的是有很多个格式一样的表位于不同的工作簿中，需要合并到一个工作表里，需要打开，复制，粘贴，关闭，打开，复制，粘贴，关闭…… 都感觉自己快成了一个机器人了…… 对于同一个工作簿中有很多格式相同的表想合并在一起的情况，如果不懂VBA代码的话，可以参考我以前写的一篇文章： 《 通过查询快速合并多个报表 》 当然，我们也可以通过下载一些Excel插件来实现报表的合并，但今天我们分享的主要是通过VBA代码来合并报表。大家可以收藏本文，需要的时候直接使用，非常方便。

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

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

具体步骤：

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

代码如下：

Sub 合并当前工作簿下的所有工作表()Application.ScreenUpdating = FalseFor j = 1 To Sheets.Count   If Sheets(j).Name <> ActiveSheet.Name Then       X = Cells(Rows.Count,1).End(xlUp).Row + 1       Sheets(j).UsedRange.Copy Cells(X, 1)   End IfNextApplication.ScreenUpdating = TrueMsgBox "当前工作簿下的全部工作表已经合并完毕！", vbInformation, "提示"End Sub

注意：此代码是把每个sheet里面的内容(包括标题行)直接复制到汇总sheet里了，所以汇总后需要手动删除多余的表头。

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

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

代码如下：

Sub 合并当前目录下所有工作簿的全部工作表()Dim MyPath, MyName, AWbNameDim Wb As Workbook, WbN As StringDim G As LongDim Num As LongDim BOX As StringApplication.ScreenUpdating = FalseMyPath = ActiveWorkbook.PathMyName = Dir(MyPath & "\" & "*.xlsx")AWbName = ActiveWorkbook.NameNum = 0Do 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 = DirLoopApplication.ScreenUpdating = TrueMsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"End Sub

注意此代码合并的是扩展名为xlsx的工作簿中的表，如果扩展名为xls，请修改代码中红色字体部分，请根据自己的版本更改。

3多个工作簿中指定的sheet合并到新的工作簿中

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

代码如下：

Sub 汇总数据()Application.ScreenUpdating = FalseDim wb, wb1 As Excel.WorkbookDim sh As Excel.Worksheets = 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 = DirLoopThisWorkbook.Worksheets("汇总").ActivateApplication.ScreenUpdating = TrueEnd Sub

三种情况下的合并全在此了，当然能看懂VBA代码那就更好了，至少出问题时知道怎么去修改，而且以上的代码并不难，参加我的VBA入门班，6节课程全部学习完后，上面的代码全部可以自己写出来。

所以如果你想做自动化报表，如果你常做一些重复性的工作，如果你想提升自己的技能以便节省出更多的时间做更多有意义的事情，那还考虑什么呢，下定决心学习下VBA吧！

今天的分享就到这里，当然还是建议你学习下VBA，至少能看懂代码，会简单的修改！

鼓励一下，赞完再走