Объединить листы с заготовками в один лист - VBA

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