Code

Sub Dateien_zusammenfuehren() 
 
'Führt alle Tabellenblätter der ausgewählten Excel-Dateien in dieser Arbeitsmappe zusammen 
 
Dim wbQuelle As Workbook 
Dim sh As Worksheet 
Dim arrdateien As Variant 
Dim cntDatei As Long 
 
'Screenupdating deaktivieren 
Application.ScreenUpdating = False 
 
'Benutzer Dateien auswählen lassen 
arrdateien = Application.GetOpenFilename(filefilter:="Excel-Dateien (*.xls*),*.xls*", MultiSelect:=True) 
 
'Wurde mindestens eine Datei ausgewählt? 
If IsArray(arrdateien) Then 
    'Schleife über alle ausgewählten Dateien 
    For cntDatei = 1 To UBound(arrdateien) 
     
        'Aktuelle Arbeitsmappe öffnen 
        Set wbQuelle = Workbooks.Open(Filename:=arrdateien(cntDatei), UpdateLinks:=False, ReadOnly:=True) 
         
        'Schleife über alle Tabellenblätter 
        For Each sh In wbQuelle.Worksheets 
            'Aktuelles Tabellenblatt kopieren 
            sh.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 
        Next sh 
         
        'Aktuelle Arbeitsmappe schließen 
        wbQuelle.Close savechanges:=False 
         
    Next cntDatei 
End If 
 
'Screenupdating aktivieren 
Application.ScreenUpdating = True 
 
'Bereitgestellt von VBATrainer: www.vbatrainer.de

End Sub