Sub Kopir()
   Dim sh0 As Worksheet
   Dim sh As Worksheet
   Dim H As Integer, lr As Long, i As Long
   
   Application.ScreenUpdating = False
   Set sh0 = Sheets("лист1")
   With sh0
      For Each sh In Sheets 'цикл по всем листам
         If sh.Name <> sh0.Name Then 'без обработки останется только лист лист1
         
         H = sh.Cells(Cells.Rows.Count,  1 ).End(xlUp).Row
   
            lr = .Cells(Cells.Rows.Count,  1 ).End(xlUp).Row
             
           sh.Rows("1:" & H).Copy .Cells(lr +  1 ,  1 )
     
         End If
      Next sh
        
       End With
          ' Sheets(sh.Name).Columns("A:B").Copy Sheets("Лист1").Columns("A:B") 
   Application.CutCopyMode = False
   Application.ScreenUpdating = True
End Sub