合并EXCEL工作簿中表格(sheet)的三种情况教程及代码

《合并EXCEL工作簿中表格(sheet)的三种情况教程及代码》由会员上传分享，免费在线阅读，更多相关内容在行业资料-天天文库。

1、一、操作方法将所有要合并的工作簿存放到同目录下，在同目录下新建“汇总工作簿.xls”,打开后，按Alt+F11进入代码编辑界面,点击插入-模块，将代码复制粘贴进去，点击运行。二、将多个工作簿的所有工作表(sheet)复制到一个工作簿内,代码：SubCombineFiles()DimpathAsStringDimFileNameAsStringDimLastCellAsRangeDimWkbAsWorkbookDimWSAsWorksheetDimThisWBAsStringDimMyDirAsStringMyDir=ThisWorkbook.path&""'C

2、hDriveLeft(MyDir,1)'findalltheexcelfiles'ChDirMyDir'Match=Dir$("")ThisWB=ThisWorkbook.NameApplication.EnableEvents=FalseApplication.ScreenUpdating=Falsepath=MyDirFileName=Dir(path&"*.xls",vbNormal)DoUntilFileName=""IfFileName<>ThisWBThenSetWkb=Workbooks.Open(FileName:=path&""&FileN

3、ame)ForEachWSInWkb.WorksheetsSetLastCell=WS.Cells.SpecialCells(xlCellTypeLastCell)IfLastCell.Value=""AndLastCell.Address=Range("$A$1").AddressThenElseWS.CopyAfter:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)EndIfNextWSWkb.CloseFalseEndIfFileName=Dir()LoopApplication.EnableEvents=T

4、rueApplication.ScreenUpdating=TrueSetWkb=NothingSetLastCell=NothingEndSub三、将多个工作簿的第一张工作表（sheet）复制到一个工作簿内,代码：PrivateSub合并工作薄()Dimf_nameAsStringDimbok1AsWorkbook,bok2AsWorkbookSetbok2=Nothingf_name=Dir(ThisWorkbook.Path&"*.*")'获得该目录下的所有EXCEL文件DoWhilef_name<>""'开始执行循环Iff_name<>ThisWork

5、book.NameThen'如果当前的文件不是代码所在文件，执行合并操作Setbok1=Workbooks.Open(ThisWorkbook.Path&""&f_name)'打开被合并的文件Ifbok2IsNothingThen'合并后的文件是否存在bok1.Sheets(1).Copy'如果合并后的文件不存在，则创建一个Setbok2=ActiveWorkbookElsebok1.Sheets(1).CopyBefore:=bok2.Sheets(1)'如果合并后的文件存，在则将被合并文件的第一个工作表复制到合并文件中。EndIfbok1.Close'关闭

6、被合并文件EndIff_name=Dir()'获取下一个被合并文件名LoopEndSub四、将多个工作簿的所有工作表（sheet）复制到一个工作簿的同一个sheet内,代码：Sub合并当前目录下所有工作簿的全部工作表()DimMyPath,MyName,AWbNameDimWbAsWorkbook,WbNAsStringDimGAsLongDimNumAsLongDimBOXAsStringApplication.ScreenUpdating=FalseMyPath=ActiveWorkbook.PathMyName=Dir(MyPath&""&"*.xls"

7、)AWbName=ActiveWorkbook.NameNum=0DoWhileMyName<>""IfMyName<>AWbNameThenSetWb=Workbooks.Open(MyPath&""&MyName)Num=Num+1WithWorkbooks(1).ActiveSheet.Cells(.Range("A65536").End(xlUp).Row+2,1)=Left(MyName,Len(MyName)-4)ForG=1ToSheets.CountWb.Sheets(G).UsedRange.Copy.Cells(.Range("A65536

8、").End(xlUp)