首页 > 代码库 > vba实现excel多表合并

vba实现excel多表合并

Excel多表合并之vba实现

需求

保留列名,复制每一个excel里的数据,合并到一个excel

操作步骤

  1. 将要合并的文件放在同一文件夹下,复制过来就好(ps:最好不要直接操作原数据文件,避免操作失败,数据丢失)
  2. 在这个目录下创建一个“合并.xlsx”
  3. 双击打开“合并.xlsx”
  4. 同时按 ALT + F11
  5. 出现下图,按图中文字操作即可完成合并

 

  1. 完成

 

 

 

 

附录代码

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