多个工作簿数据合并到一个工作表

合并工作簿Subcombinebooks()Application.DisplayAlerts=FalseApplication.ScreenUpdating=FalseApplication.EnableEvents=FalseApplication.AskToUpdateLinks=FalseFileToOpen_N=Application.GetOpenFilename("xls文件,*.xls",_Title:="请选择要合并工作簿：",MultiSelect:=True)Newbz=0OnErrorResumeNextForEachFileToOpenInFileToOpen_NIfFileToOpen<>FalseThenIfNewbz=0ThenBooknum=Application.SheetsInNewWorkbookApplication.SheetsInNewWorkbook=1Workbooks.AddApplication.SheetsInNewWorkbook=Booknumnewbookname=ActiveWorkbook.NameSheets(1).Name="sheet_tmp"Newbz=1EndIfSetopenbook=Workbooks.Open(FileToOpen)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).Sheets("sheet_tmp").DeleteApplication.ScreenUpdating=TrueApplication.DisplayAlerts=TrueApplication.AskToUpdateLinks=TrueApplication.EnableEvents=TrueEndSubFunctionkill_macro(newbookname)OnErrorResumeNextDimVbcAsObjectApplication.AskToUpdateLinks=FalseForEachVbcInWorkbooks(newbookname).VBProject.VBComponentsSelectCaseVbc.TypeCase1,2,3WithApplication.Workbooks(newbookname).VBProject.VBComponents.Remove.Item(Vbc.Name)EndWithCaseElseVbc.CodeModule.DeleteLines1,Vbc.CodeModule.CountOfLines'删除第1至最後1行码EndSelectNextApplication.EnableEvents=TrueApplication.AskToUpdateLinks=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"&o+1).SelectActiveSheet.PasteNextEndSub