Sub sbor()
    With Sheets(2): arr1 = .Range(.Cells(1), .Cells.SpecialCells(xlCellTypeLastCell)): End With
    With Sheets(3): arr2 = .Range(.Cells(2, 1), .Cells.SpecialCells(xlCellTypeLastCell)): End With
    Sheets(5).Cells(1).Resize(UBound(arr1), UBound(arr1, 2)).Value = arr1
    Sheets(5).Cells(UBound(arr1) + 1, 1).Resize(UBound(arr2), UBound(arr2, 2)).Value = arr2
End Sub

Sub sbor()
    With Sheets(2): arr1 = .Range(.Cells(1), .Cells.SpecialCells(xlCellTypeLastCell)): End With
    With Sheets(3): arr2 = .Range(.Cells(2, 1), .Cells.SpecialCells(xlCellTypeLastCell)): End With
    With Sheets(4): arr3 = .Range(.Cells(2, 1), .Cells.SpecialCells(xlCellTypeLastCell)): End With
    Sheets(5).Cells(1).Resize(UBound(arr1), UBound(arr1, 2)).Value = arr1
    Sheets(5).Cells(UBound(arr1) + 1, 1).Resize(UBound(arr2), UBound(arr2, 2)).Value = arr2
    Sheets(5).Cells(UBound(arr1) + UBound(arr2) + 1, 1).Resize(UBound(arr3), UBound(arr3, 2)).Value = arr3
End Sub

Private Sub CommandButton1_Click()
    Me.Hide
    On Error Resume Next
    With Application: .EnableEvents = 0: .ScreenUpdating = 0
        With ActiveSheet.UsedRange
            Intersect(.Cells, .Offset(1)).Delete xlUp
        End With
        With ListBox1
            For i = 0 To .ListCount - 1
                If .Selected(i) Then
                    With ThisWorkbook.Sheets(.List(i)).UsedRange
                        Intersect(.Cells, .Offset(1)).Copy _
                            [A1].Offset(Cells(Rows.Count, 1).End(xlUp).Row)
                    End With
                End If
            Next
        End With
    .EnableEvents = 1: .ScreenUpdating = 1: End With
    Unload Me
End Sub
Private Sub UserForm_Initialize()
    Dim SH As Worksheet
    For Each SH In ThisWorkbook.Sheets
        If Not SH Is ActiveSheet Then Me.ListBox1.AddItem SH.Name
    Next
End Sub

With Sheets("имя_листа")