Excel VBA: 如何将特定工作表合并到同一个工作簿中？

Question

我有一个包含 10 个作品的工作簿sheet，其中 6 个需要合并为一个作品sheet。这 6 个都具有相同的 header 行。有时我可以让我的代码正常工作。但是，如果其中一个作品sheet为空（只有header行），header将被复制到新的合并sheet.

我试过添加一个 "On Error Resume Next"，这只会防止产生错误。它仍然只复制 header 行。

Sub Combine()
    Dim s As Worksheet

    On Error Resume Next
    Application.DisplayAlerts = False

    Sheets("All").Delete 'These sheets don't need to be kept or consolidated
    Sheets("005").Delete
    Sheets("006").Delete
    Sheets("007").Delete

    Application.DisplayAlerts = True
    On Error GoTo 0

    Sheets(1).Select
    Worksheets.Add
    Sheets(1).Name = "0"

    Sheets(2).Activate
    Range("A1").EntireRow.Select
    Selection.Copy Destination:=Sheets(1).Range("A1")

    For Each s In ActiveWorkbook.Sheets
            If s.Name <> "0" Then
                Application.GoTo Sheets(s.Name).[a1]
                Selection.CurrentRegion.Select
                'On Error Resume Next
                Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
                Selection.Copy Destination:=Sheets("0"). _
                Cells(Rows.Count, 1).End(xlUp)(2)
                'On Error GoTo 0
            End If
        Next
End Sub

我需要让宏只复制 header 下面的填充行，并跳过恰好为空白的任何 sheet。

Answer 1

类似这样的东西 - 这里有一些其他建议：

Sub Combine()

    Dim s As Worksheet, wb As Workbook, wsDest As Worksheet, rngCopy As Range

    Set wb = ActiveWorkbook  '<< always specify a workbook

    Application.DisplayAlerts = False
    On Error Resume Next
    wb.Sheets("All").Delete 'These sheets don't need to be kept or consolidated
    wb.Sheets("005").Delete
    wb.Sheets("006").Delete
    wb.Sheets("007").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    'get a direct reference to the newly-added sheet
    Set wsDest = wb.Worksheets.Add(before:=wb.Worksheets(1))
    wsDest.Name = "0"

    wb.Sheets(2).Range("A1").EntireRow.Copy Destination:=wsDest.Range("A1")

    For Each s In ActiveWorkbook.Sheets
        If s.Name <> wsDest.Name Then    '<< remove hard-coded name
            Set rngCopy = s.Range("A1").CurrentRegion
            'check how many rows before copying
            If rngCopy.Rows.Count > 1 Then
                'no need for select/activate
                rngCopy.Offset(1, 0).Resize(rngCopy.Rows.Count - 1).Copy _
                   wsDest.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
            End If
        End If
    Next s
End Sub

Excel VBA: 如何将特定工作表合并到同一个工作簿中？

Excel VBA: How to consolidate specific worksheets in the same workbook?

excel

vba

worksheet

consolidation