合并拆分多个excle的代码.docx

《合并拆分多个excle的代码.docx》由会员上传分享，免费在线阅读，更多相关内容在教育资源-天天文库。

1、拆分：把单个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.Scr

2、eenUpdating=FalseApplication.DisplayAlerts=FalseForEachshtInSheetssht.CopyActiveWorkbook.Sheets(1).Name=shtNameActiveWorkbook.SaveAsFilename:=ThisWorkbook.Path&""&sht.Name&".xls"ActiveWorkbook.CloseNextApplication.DisplayAlerts=TrueApplication.ScreenUpdating=TrueEndSub合并：同一E

3、xcel表格中的多个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(x

4、lUp).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。方法如下：1.将多个excel放到同一个文件夹中，在文件夹中新建一个表格2

5、.打开新建表格3.右击sheet1，点击“查看代码”4.复制如下代码5.运行—运行子过程6.一起选中多个excel，确定保存7.Alt+F11返回SubBooks2Sheets()    '定义对话框变量    DimfdAsFileDialog    Setfd=Application.FileDialog(msoFileDialogFilePicker)        '新建一个工作簿    DimnewwbAsWorkbook    Setnewwb=Workbooks.Add        Withfd        If.Show=-1

6、Then            '定义单个文件变量            DimvrtSelectedItemAsVariant                        '定义循环变量            DimiAsInteger            i=1                        '开始文件检索            ForEachvrtSelectedItemIn.SelectedItems                '打开被合并工作簿                DimtempwbAsWorkbook

7、                Settempwb=Workbooks.Open(vrtSelectedItem)                                '复制工作表                tempwb.Worksheets(1).CopyBefore:=newwb.Worksheets(i)                                '把新工作簿的工作表名字改成被复制工作簿文件名，这儿应用于xls文件，即Excel97-2003的文件，如果是Excel2007，需要改成xlsx        

8、        newwb.Worksheets(i).Name=VBA.Replace(tempwb.Name,".xls","")