Question

我知道这个问题已经问过几次了，但是似乎没有解决方案对我有用。我有一本大型工作簿，其中包含50个公司的数据，分布在50个工作表中。

我的目标是将所有内容组合成一个大的“组合”表，其中包括所有数据。但是，工作表上的数据有时会有空白。另外，我的代码没有通用的标头。而是第一行始终是公司名称，该公司名称也应转移到合并的工作表中。

在下面查看我的屏幕截图：

我尝试了下面的代码，但它仅合并了标头。

Sub Combine()
 Dim J As Integer
  On Error Resume Next
  Sheets(1).Select
  Worksheets.Add
  Sheets(1).Name = "Combined"
  Sheets(2).Activate
  Range("A1").EntireRow.Select
  Selection.Copy Destination:=Sheets(1).Range("A1")
 For J = 2 To Sheets.Count
  Sheets(J).Activate
  Range("A1").Select
  Selection.CurrentRegion.Select
  Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
  Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
 Next
End Sub

运行代码仅给我标题行，而不给其余数据。

查看结果：

任何建议将不胜感激，谢谢！

Answer 1

Sub Combine()
Dim ws as Worksheet, Combined as Worksheet
Dim LastRow as Long, iRow as Long
Set Combined = ThisWorkbook.Worksheets.Add
Combined.Name = "Combined"
iRow = 1

For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Combined" Then
        With ws
            If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
                LastRow = .Cells.Find(What:="*", _
                              After:=.Range("A1"), _
                              Lookat:=xlPart, _
                              LookIn:=xlFormulas, _
                              SearchOrder:=xlByRows, _
                              SearchDirection:=xlPrevious, _
                              MatchCase:=False).Row
                .Range("A1:J" & LastRow).Copy _
                    Destination:= Combined.Range("A" & iRow)
                iRow = iRow + LastRow
            End If
        End With
    End If
Next ws

End Sub

将带有空白的工作表合并为一张表-VBA

1 个答案: