欢迎来到天天文库
浏览记录
ID:41328121
大小:16.96 KB
页数:3页
时间:2019-08-22
《合并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)
此文档下载收益归作者所有