Private Sub CommandButton1_Click()
x = 4
a = ActiveWorkbook.Path
'1.Sheet
                                Dim objsheet1, objsheet1a As Object
 
                                Set objsheet1 = GetObject(a & _
                                  "\Aktivitätsplan1.xls")
                                With objsheet1
                                Set objsheet1a = .Worksheets( _
                                  "Tabelle1").[A1].CurrentRegion
 
                                For i = 5 To .Worksheets( _
                                  "Tabelle1").Cells.SpecialCells( _
                                  xlCellTypeLastCell).Row
 
                                        .Worksheets("Tabelle1").Rows(i).Copy
                                        ActiveSheet.Range("A" & x).PasteSpecial _
                                          xlAll
                                        x = x + 1
 
                                Next i
                                End With
                                Set objsheet1 = Nothing
                                Set objsheet1a = Nothing
 
x = [A65536].End(xlUp).Row + 1
'2.Sheet
                                Dim objsheet2, objsheet2a As Object
 
                                Set objsheet2 = GetObject(a & _
                                  "\Aktivitätsplan2.xls")
                                With objsheet2
                                Set objsheet2a = .Worksheets( _
                                  "Tabelle1").[A1].CurrentRegion
 
                                For a = 5 To .Worksheets( _
                                  "Tabelle1").Cells.SpecialCells( _
                                  xlCellTypeLastCell).Row
 
                                        .Worksheets("Tabelle1").Rows(a).Copy
                                        ActiveSheet.Range("A" & x).PasteSpecial _
                                          xlAll
                                        x = x + 1
 
                                Next a
                                End With
                                Set objsheet2 = Nothing
                                Set objsheet2a = Nothing
x = [A65536].End(xlUp).Row + 1
'3.Sheet
                                Dim objsheet3, objsheet3a As Object
 
                                Set objsheet3 = GetObject(a & _
                                  "\Aktivitätsplan3.xls")
                                With objsheet3
                                Set objsheet3a = .Worksheets( _
                                  "Tabelle1").[A1].CurrentRegion
 
                                For a = 5 To .Worksheets( _
                                  "Tabelle1").Cells.SpecialCells( _
                                  xlCellTypeLastCell).Row
 
                                        .Worksheets("Tabelle1").Rows(a).Copy
                                        ActiveSheet.Range("A" & x).PasteSpecial _
                                          xlAll
                                        x = x + 1
 
                                Next a
                                End With
                                Set objsheet3 = Nothing
                                Set objsheet23 = Nothing
end sub