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

拆分：把单个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返回Sub Macro1() Dim sht As Worksheet Dim shtName As String shtName = Sheet1 Application.ScreenUpdating = False Application.DisplayAlerts = False For Each sht In Sheets sht.Copy ActiveWorkbook.Sheets(1).Name = shtName ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path sht.Name .xls ActiveWorkbook.Close Next Application.DisplayAlerts = True Application.ScreenUpdating = TrueEnd Sub合并：同一Excel表格中的多个sheet全部合并到sheet1如：123.xls含有三个sheet分别为a、b、c；将b、c数据全部合并到a中，方法如下：1、 打开excel表，右击sheet1，左击“查看代码”2、 复制如下代码到空白处3、 点击运行运行子过程，10秒合并完成4、 Alt+F11返回Sub 合并当前工作簿下的所有工作表()Application.ScreenUpdating = FalseFor j = 1 To Sheets.Count If Sheets(j).Name ActiveSheet.Name Then X = Range(A65536).End(xlUp).Row + 1 Sheets(j).UsedRange.Copy Cells(X, 1) End IfNextRange(B1).SelectApplication.ScreenUpdating = TrueMsgBox 当前工作簿下的全部工作表已经合并完毕！, vbInformation, 提示End Sub合并：将多个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返回Sub Books2Sheets()定义对话框变量Dim fd As FileDialogSet fd = Application.FileDialog(msoFileDialogFilePicker)新建一个工作簿Dim newwb As WorkbookSet newwb = Workbooks.AddWith fdIf .Show = -1 Then定义单个文件变量Dim vrtSelectedItem As Variant定义循环变量Dim i As Integeri = 1开始文件检索For Each vrtSelectedItem In .SelectedItems打开被合并工作簿Dim tempwb As WorkbookSet tempwb = Workbooks.Open(vrtSelectedItem)复制工作表tempwb.Worksheets(1).Copy Before:=newwb.Worksheets(i)把新工作簿的工作表名字改成被复制工作簿文件名，这儿应用于xls文件，即Excel97-2003的文件，如果是Excel2007，需要改成xlsxnewwb.Worksheets(i).Name = VBA.Replace(tempwb.Name, .xls, )关闭被合并工作簿tempwb.Close SaveChanges:=Falsei = i + 1Next vrtSelectedItemEnd IfEnd WithSet fd = NothingEnd Sub合并：将多个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 合并当前目录下所有工作簿的全部工作表()Dim MyPath, MyName, AWbNameDim Wb As Workbook, WbN As StringDim G As LongDim Num As LongDim BOX As StringApplication.ScreenUpdating = FalseMyPath = ActiveWorkbook.PathMyName = Dir(MyPath *.xls)AWbName = ActiveWorkbook.NameNum = 0Do While MyName If MyName AWbName ThenSet Wb = Workbooks.Open(MyPath MyName)Num = Num + 1With Workbooks(1).ActiveSheet.Cells(.Range(B65536).End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)For G = 1 To Sheets.CountWb.Sheets(G).UsedRange.Copy .Cells(.Range(B65536).End(xlUp).Row + 1, 1)NextWbN = WbN Chr(13) Wb.NameWb.Close FalseEnd Wi