欢迎来到天天文库
浏览记录
ID:36559827
大小:32.00 KB
页数:3页
时间:2019-05-12
《多个工作簿数据合并到一个工作表》由会员上传分享,免费在线阅读,更多相关内容在教育资源-天天文库。
1、合并工作簿Subcombinebooks()Application.DisplayAlerts=FalseApplication.ScreenUpdating=FalseApplication.EnableEvents=FalseApplication.AskToUpdateLinks=FalseFileToOpen_N=Application.GetOpenFilename("xls文件,*.xls",_Title:="请选择要合并工作簿:",MultiSelect:=True)Newbz=0OnErrorResumeNextForEachFileTo
2、OpenInFileToOpen_NIfFileToOpen<>FalseThenIfNewbz=0ThenBooknum=Application.SheetsInNewWorkbookApplication.SheetsInNewWorkbook=1Workbooks.AddApplication.SheetsInNewWorkbook=Booknumnewbookname=ActiveWorkbook.NameSheets(1).Name="sheet_tmp"Newbz=1EndIfSetopenbook=Workbooks.Open(FileTo
3、Open)ForEachxlsheetInopenbook.Sheetsxlsheet.Name=Left(Trim(openbook.Name),Len(Trim(openbook.Name))-4)'&";"&xlsheet.Namexlsheet.CopyBefore:=Workbooks(newbookname).Sheets("sheet_tmp")Nextopenbook.CloseSaveChanges:=FalseEndIfNextCallkill_macro(newbookname)Workbooks(newbookname).Shee
4、ts("sheet_tmp").DeleteApplication.ScreenUpdating=TrueApplication.DisplayAlerts=TrueApplication.AskToUpdateLinks=TrueApplication.EnableEvents=TrueEndSubFunctionkill_macro(newbookname)OnErrorResumeNextDimVbcAsObjectApplication.AskToUpdateLinks=FalseForEachVbcInWorkbooks(newbookname
5、).VBProject.VBComponentsSelectCaseVbc.TypeCase1,2,3WithApplication.Workbooks(newbookname).VBProject.VBComponents.Remove.Item(Vbc.Name)EndWithCaseElseVbc.CodeModule.DeleteLines1,Vbc.CodeModule.CountOfLines'删除第1至最後1行码EndSelectNextApplication.EnableEvents=TrueApplication.AskToUpdate
6、Links=TrueEndFunction合并工作表Sub合并工作表()DimmAsIntegerDimnAsIntegerDimoAsIntegerForm=2To58'插入一个汇总表页,58为总工作表数量n=Sheets(m).[a65536].End(xlUp).Rowo=Sheets(1).[a65536].End(xlUp).RowSheets(m).SelectRange("a1","z"&n).Select'复制区域A1Range("a"&n).ActivateSelection.CopySheets(1).SelectRange("a"&
7、o+1).SelectActiveSheet.PasteNextEndSub
此文档下载收益归作者所有