首页 > 代码库 > vba实现excel多表合并
vba实现excel多表合并
Excel多表合并之vba实现
需求
保留列名,复制每一个excel里的数据,合并到一个excel
操作步骤
- 将要合并的文件放在同一文件夹下,复制过来就好(ps:最好不要直接操作原数据文件,避免操作失败,数据丢失)
- 在这个目录下创建一个“合并.xlsx”
- 双击打开“合并.xlsx”
- 同时按 ALT + F11
- 出现下图,按图中文字操作即可完成合并
- 完成
附录代码
Sub 合并当前目录下所有工作簿的全部工作表() Dim MyPath, MyName, AWbName Dim Wb As Workbook, WbN As String Dim G As Long Dim Num As Long Dim BOX As String flag = 0 Application.ScreenUpdating = False MyPath = ActiveWorkbook.Path MyName = Dir(MyPath & "\" & "*.xls") AWbName = ActiveWorkbook.Name Num = 0 Do While MyName <> "" If MyName <> AWbName Then Set Wb = Workbooks.Open(MyPath & "\" & MyName) Num = Num + 1 With Workbooks(1).ActiveSheet For G = 1 To Sheets.Count If flag = 0 Then Wb.Sheets(G).UsedRange.Copy .Cells(.Range("A65536").End(xlUp).Row , 1) flag = 1 Else Wb.Sheets(G).Range("a2", Wb.Sheets(G).Cells.SpecialCells(xlCellTypeLastCell)).Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1) End If Next WbN = WbN & Chr(13) & Wb.Name Wb.Close False End With End If MyName = Dir Loop Range("A1").Select Application.ScreenUpdating = True MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下:" & Chr(13) & WbN, vbInformation, "提示"End Sub
声明:以上内容来自用户投稿及互联网公开渠道收集整理发布,本网站不拥有所有权,未作人工编辑处理,也不承担相关法律责任,若内容有误或涉及侵权可进行投诉: 投诉/举报 工作人员会在5个工作日内联系你,一经查实,本站将立刻删除涉嫌侵权内容。