Excel多表合并vba代码

1：多个excel复制到一个excel中的不同sheet

使用步骤：将代码复制进vba编程界面（不知道可以百度下怎么打开vba编程界面）启用宏，选好想要的合并的excel文件即可

Sub Books2Sheets()  
'定义对话框变量
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
'新建一个工作簿
Dim newwb As Workbook
Set newwb = Workbooks.Add
With fd
If .Show = -1 Then
'定义单个文件变量
Dim vrtSelectedItem As Variant
'定义循环变量
Dim i As Integer
i = 1
'开始文件检索
For Each vrtSelectedItem In .SelectedItems
'打开被合并工作簿
Dim tempwb As Workbook
Set tempwb = Workbooks.Open(vrtSelectedItem)
'复制工作表
tempwb.Worksheets.Copy Before:=newwb.Worksheets(i)
'把新工作簿的工作表名字改成被复制工作簿文件名，这儿应用于xls文件，即Excel97-2003的文件，如果是Excel2007，需要改成xlsx
newwb.Worksheets(i).Name = VBA.Replace(tempwb.Name, ".xlsx", "")
'关闭被合并工作簿
tempwb.Close SaveChanges:=False
i = i + 1
Next vrtSelectedItem
End If
End With
Set fd = Nothing
End Sub

效果如图：

 

 

2：创建一个叫做汇总的sheet用来放你的汇总数据（名字可以自己改），跟上面的步骤一样，启用宏代码即可，注意：其中的合并顺序是你自己sheet的下面从左至右的顺序→，可以自己调好顺序后再用宏

Sub 合并工作簿内的多个Sheet到同一个Sheet()
    Dim i As Long, j As Long 'i是数据源表的最后一行，j是目标表(数据表)的最后一行
    Dim sht As Worksheet
    Dim lastRow As Long
    
    Application.ScreenUpdating = False '关闭屏幕刷新
    
    '先要删除所有数据
    Sheets("汇总").Range("A1:Z" & Rows.Count).ClearContents
    
    '复制数据
    For Each sht In Sheets
        If sht.Name <> "汇总" Then
            i = sht.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
            lastRow = GetLastNonEmptyRow(Sheets("汇总"), 1, i)
            If lastRow = 1 And IsEmpty(Sheets("汇总").Range("A1")) Then
                lastRow = 0
            End If
            j = GetLastNonEmptyRow(Sheets("汇总"), 1, Columns.Count)
            sht.Range("A1:IV" & i).Copy Destination:=Sheets("汇总").Range("A" & j + 1)
        End If
    Next
    
    Application.ScreenUpdating = True '打开屏幕刷新
    
    MsgBox "执行完毕！"
End Sub

Function GetLastNonEmptyRow(ws As Worksheet, startColumn As Long, endColumn As Long) As Long
    Dim lastRow As Long
    Dim i As Long
    
    lastRow = ws.Cells(Rows.Count, startColumn).End(xlUp).row
    For i = startColumn To endColumn
        lastRow = WorksheetFunction.Max(lastRow, ws.Cells(Rows.Count, i).End(xlUp).row)
    Next i
    
    GetLastNonEmptyRow = lastRow
End Function

效果如图：

 

行数经过核实都是一致的，但是有些表内计算的单元格可能会因为位置变动而失效，这点需要注意