求助各位大神：多工作簿多表（表头不同）合并成多个工作表，结果为一个工作簿多个...

风清扬1995

求助各位大神：多工作簿多表（表头不同）合并成多个工作表，结果为一个工作簿多个工作表。1、excel汇总大师极速版好像没有此项功能是吧？2、网上看到有位高手有表格合并模版。
恳请各位大神出手指导一下

3190496160

Sub 合并()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set ww = ThisWorkbook
For Each sh In Sheets
    If sh.Index > 1 Then
        sh.Delete
    End If
Next sh
f = Dir(ThisWorkbook.Path & "\*.xls*")
Do While f <> ""
    If f <> ThisWorkbook.Name Then
        Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f, 0)
        m = m + 1
        For Each sht In wb.Worksheets
            If sht.Index <> 3 Then
                If sht.Index = 1 Then
                    ks = 6
                Else
                    ks = 4
                End If
                r = sht.Cells(sht.Rows.Count, 2).End(xlUp).Row + 1
                rs = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row
                If m = 1 Then
                    sht.Copy after:=ww.Worksheets(ww.Worksheets.Count)
                    With ww.Worksheets(ww.Worksheets.Count)
                        If rs > r Then .Rows(r & ":" & rs).Delete
                    End With
                Else
                    With ww.Worksheets(sht.Name)
                        ws = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
                        sht.Rows(ks & ":" & r).Copy .Cells(ws, 1)
                    End With
                End If
            End If
        Next sht
        wb.Close False
    End If
f = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

3190496160

多工作簿多表（表头不同）合并成多个工作表之例子.rar (66.35 KB, 下载次数: 13)

2023-9-18 11:08 上传

点击文件名下载附件