Excel VBA:如何在同一工作簿中合并特定工作表?

Question

我有一个包含 10 个工作表的工作簿，其中 6 个需要合并到一个工作表中。 这 6 个都有相同的标题行。 我可以让我的代码在某些时候工作。 但是，如果其中一个工作表为空(只有标题行(，则标题将被复制到新的合并工作表中。

我尝试添加"下次恢复错误"，这只能防止生成错误。它仍然只复制标题行。

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

我需要让宏副本仅填充标题下方的行，并跳过任何碰巧为空白的工作表。

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