合并拆分多个excle的代码VIP免费

拆分：把单个excle表格中的多个sheet，分成多个单个excel如：123.xls含有三个sheet分别为a、b、c；拆分成a.xls、b.xls、c.xls，拆分后的a.xls、b.xls、c.xls含有相同名称的sheet，方法如下：1.打开excel表，并右键单击sheet1，点击“查看代码”。2.复制如下代码到空白处3.点击运行——运行子过程，10秒生成到桌面上4.Alt+F11返回SubMacro1()DimshtAsWorksheetDimshtNameAsStringshtName="Sheet1"Application.ScreenUpdating=FalseApplication.DisplayAlerts=FalseForEachshtInSheetssht.CopyActiveWorkbook.Sheets(1).Name=shtNameActiveWorkbook.SaveAsFilename:=ThisWorkbook.Path&"\"&sht.Name&".xls"ActiveWorkbook.CloseNextApplication.DisplayAlerts=TrueApplication.ScreenUpdating=TrueEndSub合并：同一Excel表格中的多个sheet全部合并到sheet1如：123.xls含有三个sheet分别为a、b、c；将b、c数据全部合并到a中，方法如下：1、打开excel表，右击sheet1，左击“查看代码”2、复制如下代码到空白处3、点击运行——运行子过程，10秒合并完成4、Alt+F11返回Sub合并当前工作簿下的所有工作表()Application.ScreenUpdating=FalseForj=1ToSheets.CountIfSheets(j).Name<>ActiveSheet.NameThenX=Range("A65536").End(xlUp).Row+1Sheets(j).UsedRange.CopyCells(X,1)EndIfNextRange("B1").SelectApplication.ScreenUpdating=TrueMsgBox"当前工作簿下的全部工作表已经合并完毕！",vbInformation,"提示"EndSub合并：将多个excel合并成一个excel中多个sheet如：将a.xls、b.xls、c.xls合并成123.xls；其中123.xls包含三个sheet：a、b、c。方法如下：5.将多个excel放到同一个文件夹中，在文件夹中新建一个表格6.打开新建表格7.右击sheet1，点击“查看代码”8.复制如下代码9.运行—运行子过程10.一起选中多个excel，确定保存11.Alt+F11返回SubBooks2Sheets()'定义对话框变量DimfdAsFileDialogSetfd=Application.FileDialog(msoFileDialogFilePicker)'新建一个工作簿DimnewwbAsWorkbookSetnewwb=Workbooks.AddWithfdIf.Show=-1Then'定义单个文件变量DimvrtSelectedItemAsVariant'定义循环变量DimiAsIntegeri=1'开始文件检索ForEachvrtSelectedItemIn.SelectedItems'打开被合并工作簿DimtempwbAsWorkbookSettempwb=Workbooks.Open(vrtSelectedItem)'复制工作表tempwb.Worksheets(1).CopyBefore:=newwb.Worksheets(i)'把新工作簿的工作表名字改成被复制工作簿文件名，这儿应用于xls文件，即Excel97-2003的文件，如果是Excel2007，需要改成xlsxnewwb.Worksheets(i).Name=VBA.Replace(tempwb.Name,".xls","")'关闭被合并工作簿tempwb.CloseSaveChanges:=Falsei=i+1NextvrtSelectedItemEndIfEndWithSetfd=NothingEndSub合并：将多个excel合并成一个excel中一个sheet如：将a.xls、b.xls、c.xls合并成123.xls；其中123.xls包含一个sheet：d。方法如下：12.将多个excel放到同一个文件夹中，在文件夹中新建一个表格13.打开新建表格14.右击sheet1，点击“查看代码”15.复制如下代码16.运行—运行子过程17.一起选中多个excel，确定保存18.Alt+F11返回Sub合并当前目录下所有工作簿的全部工作表()DimMyPath,MyName,AWbNameDimWbAsWorkbook,WbNAsStringDimGAsLongDimNumAsLongDimBOXAsStringApplication.ScreenUpdating=FalseMyPath=ActiveWorkbook.PathMyName=Dir(MyPath&"\"&"*.xls")AWbName=ActiveWorkbook.NameNum=0DoWhileMyName<>""IfMyName<>AWbNameThenSetWb=Workbooks.Open(MyPath&"\"&MyName)Num=Num+1WithWorkbooks(1).ActiveSheet.Cells(.Range("B65536").End(xlUp).Row+2,1)=Left(MyName,Len(MyName)-4)ForG=1ToSheets.CountWb.Sheets(G).UsedRange.Copy.Cells(.Range("B65536").End(xlUp).Row+1,1)NextWbN=WbN&Chr(13)&Wb.NameWb.CloseFalseEndWithEndIfMyName=DirLoopRange("B1").SelectApplication.ScreenUpdating=TrueMsgBox"共合并了"&Num&"个工作薄下的全部工作表。如下："&Chr(13)&WbN,vbInformation,"提示"EndSub