Excel combinar tabla vba

Sub 合并当前工作簿下的所有工作表()
Application.ScreenUpdating = False
For j = 1 To Sheets.Count
   If Sheets(j).Name <> ActiveSheet.Name Then
       X = Cells(Rows.Count,1).End(xlUp).Row + 1
       Sheets(j).UsedRange.Copy Cells(X, 1)
   End If
Next
Application.ScreenUpdating = True
MsgBox "当前工作簿下的全部工作表已经合并完毕！", vbInformation, "提示"
End Sub 

Nota: este código copia directamente el contenido de cada hoja (incluida la fila del encabezado) en la hoja de resumen, por lo que debe eliminar manualmente el encabezado redundante después del resumen.

2. Combine tablas de varios libros de trabajo en la misma hoja en el mismo libro de trabajo

Sub 合并当前目录下所有工作簿的全部工作表()
Dim MyPath, MyName, AWbName
Dim Wb As Workbook, WbN As String
Dim G As Long
Dim Num As Long
Dim BOX As String

Application.ScreenUpdating = False
MyPath = ActiveWorkbook.Path
MyName = Dir(MyPath & "\" & "*.xlsx")
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
            .Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
            For G = 1 To Sheets.Count
                Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)
            Next
            WbN = WbN & Chr(13) & Wb.Name
            Wb.Close False
        End With
    End If
    MyName = Dir
Loop
Application.ScreenUpdating = True
MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
End Sub

Tenga en cuenta que este código fusiona las tablas en el libro de trabajo con la extensión de xlsx. Si la extensión es xls, modifique la parte de fuente roja en el código y cámbiela de acuerdo con su propia versión.

3. Combine hojas especificadas en varios libros de trabajo en un nuevo libro de trabajo

Sub 汇总数据（）
Application.ScreenUpdating = False
Dim wb, wb1 As Excel.Workbook
Dim sh As Excel.Worksheet
s = Split(ThisWorkbook.Name, ".")(1)
f = Dir(ThisWorkbook.Path & "\*" & s) '生成查找EXCEL的目录
Do While f <> "" '在目录中循环
    If f <> ThisWorkbook.Name Then  '如果不是打开的工作簿
        Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f)
        wb.Worksheets("sheet1").Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
        ActiveSheet.Name = Split(wb.Name, ".")(0)
        wb.Close
    End If
    f = Dir
Loop
ThisWorkbook.Worksheets("汇总").Activate
Application.ScreenUpdating = True
End Sub