时不时就有同学在问,一个工作簿中每天一份报表,一个月下来30份报表需要汇总成一张表,复制粘贴来的比较慢,还有的是有很多个格式一样的表位于不同的工作簿中,需要合并到一个工作表里,等等 你可以到本公众号后台回复excel扩展,去下载小工具,里面有多表合并功能,也可以利用数据查询功能合并。 今天我们来讲讲利用VBA实现多表合并的技巧,大家可以把代码收藏好,使用的时候非常的方便。 1:工作簿内多个sheet合并到一个sheet 上边动图中有1、2、3、4,4个sheet,分别是不同部门的人员信息,需要合并到汇总sheet里。 步骤: 右键点击汇总sheet表名,查看代码,把代码复制进去,点击运行,很快就可以看到合并后的结果了。 代码如下: Sub合并当前工作簿下的所有工作表() Application。ScreenUpdatingFalse Forj1ToSheets。Count IfSheets(j)。NActiveSheet。NameThen XRange(A65536)。End(xlUp)。Row1 Sheets(j)。UsedRange。CopyCells(X,1) EndIf Next Range(B1)。Select Application。ScreenUpdatingTrue MsgB当前工作簿下的全部工作表已经合并完毕!,vbInformation,提示 EndSub 2:多个工作簿中的sheet合并到一个sheet 大家仔细观察,工作簿1中有两个sheet,合并的时候都会合并进去。 代码如下: Sub合并当前目录下所有工作簿的全部工作表() DimMyPath,MyName,AWbName DimWbAsWorkbook,WbNAsString DimGAsLong DimNumAsLong DimBOXAsString Application。ScreenUpdatingFalse MyPathActiveWorkbook。Path MyNameDir(MyP。) AWbNameActiveWorkbook。Name Num0 DoWhileMyN IfMyNAWbNameThen SetWbWorkbooks。Open(MyPMyName) NumNum1 WithWorkbooks(1)。ActiveSheet 。Cells(。Range(B65536)。End(xlUp)。Row2,1)Left(MyName,Len(MyName)4) ForG1ToSheets。Count Wb。Sheets(G)。UsedRange。Copy。Cells(。Range(B65536)。End(xlUp)。Row1,1) Next WbNWbNChr(13)Wb。Name Wb。CloseFalse EndWith EndIf MyNameDir Loop Range(B1)。Select Application。ScreenUpdatingTrue MsgB共合并了N个工作薄下的全部工作表。如下:Chr(13)WbN,vbInformation,提示 EndSub 注意代码红色字体部分,根据自己的版本更改。 3:多个工作簿中的sheet1合并到新的工作簿中 多个工作簿中的表合并到一个工作簿中,不进行汇总,只是放到一个工作簿,保留原来的表名。 代码如下: Sub汇总数据() Application。ScreenUpdatingFalse Dimwb,wb1AsExcel。Workbook DimshAsExcel。Worksheet sSplit(ThisWorkbook。Name,。)(1) fDir(ThisWorkbook。Ps)生成查找EXCEL的目录 DoW在目录中循环 IThisWorkbook。NameT如果不是打开的工作簿 SetwbWorkbooks。Open(ThisWorkbook。Pf) wb。Worksheets(sheet1)。Copyafter:ThisWorkbook。Worksheets(ThisWorkbook。Worksheets。Count) ActiveSheet。NameSplit(wb。Name,。)(0) wb。Close EndIf fDir Loop ThisWorkbook。Worksheets(汇总)。Activate Application。ScreenUpdatingTrue EndSub 三种情况下的合并全在此了,不需要懂得VBA,只要复制上面代码运行下就OK了,方便吧!