Option Explicit

Sub CopyData()
       Dim sh As Worksheet, r As Range, i&
       Application.ScreenUpdating = False

       Set sh = Worksheets.Add(before:=Worksheets(1))
       Set r = Worksheets(2).Columns(1).Find(1, , xlValues, xlWhole)
       If Not r Is Nothing Then
           r.Offset(-2).EntireRow.Resize(3).Copy sh.Cells(1)
           For i = 2 To Worksheets.Count
               With Worksheets(i)
                   Set r = .Columns(1).Find(1, , xlValues, xlWhole)
                   If Not r Is Nothing Then
                       .Range(r.Offset(1), .Range("AJ" & .Rows.Count).End(xlUp)).Copy _
                     Worksheets(1).Range("B" & .Rows.Count).End(xlUp)(2).Offset(, -1)
                   End If
               End With
           Next
       End If
       Application.ScreenUpdating = True
End Sub

Sub Start()
     Call CreateSheet
     Call Copy
End Sub
Private Sub CreateSheet()
    On Error Resume Next
    Set wsSheet = Sheets("Итог")
    If Err.Number = 0 Then
       Application.DisplayAlerts = False
       Sheets("Итог").Delete
       Application.DisplayAlerts = True
    End If
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "Итог"
End Sub
Private Sub Copy()
  Dim sRng As Range  
  Dim dRng As Range  
     Application.ScreenUpdating = False
     ThisWorkbook.Sheets(1).Activate
     Set sRng = Range("A9:AJ11")
     ThisWorkbook.Sheets(Sheets.Count).Activate
     Set dRng = Range("A1")
     sRng.Copy dRng
     For i = 1 To ThisWorkbook.Sheets.Count - 1
        ThisWorkbook.Sheets(i).Activate
        Set sRng = Range(Cells(12, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
        ThisWorkbook.Sheets(Sheets.Count).Activate
        Set dRng = Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1)
        sRng.Copy dRng
     Next i
     Application.ScreenUpdating = True
End Sub

For i = 1 To ThisWorkbook.Sheets.Count - 1

Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))