Public Sub Tabellen_zusammenführen()
Dim i As Integer: i = 1
Dim wkbMain As Workbook
Dim wkbTmp As Workbook
Set wkbMain = ThisWorkbook
Do While wkbMain.Worksheets(1).Cells(i, 1) <> ""
Dim strName As String, strPath As String
strName = wkbMain.Worksheets(1).Cells(i, 1)
strPath = wkbMain.Path & "\" & wkbMain.Worksheets(1).Cells(i, 1)
Select Case Right(strPath, 4)
Case "xlsx", "xls":
Case Else:
MsgBox "Keine Excel-Dateien angegeben.", vbInformation, "Abbruch"
Exit Sub
End Select
Select Case i
Case 1:
Call Workbooks.Open(strPath)
ActiveWorkbook.Worksheets("Tabelle1").Copy
Set wkbTmp = ActiveWorkbook
Call Workbooks(strName).Close
Case Else:
Call Workbooks.Open(strPath)
ActiveWorkbook.Worksheets("Tabelle1").Copy after:=wkbTmp.Worksheets(wkbTmp.Worksheets.Count)
Call Workbooks(strName).Close
End Select
i = i + 1
Loop
Dim strDatei As String
strDatei = "Sammeldatei.xlsx"
wkbTmp.SaveAs (wkbMain.Path & "\" & strDatei)
wkbTmp.Close
Set wkbTmp = Nothing
Set wkbMain = Nothing
End Sub