VBA-Schleifchen einbauen :-)

Sub auslesen()
zahl = "0"
Application.DisplayAlerts = False ' Fehlermeldungen ausschalten
'Set ziel = ActiveWorkbook
ziel = ActiveWorkbook.Name ' Zieldatei
' Alle Dateien im Quellordner suchen
Dim i As Long
' in der Zeile Quellenordner den Pfad eingeben, wo Deine Dateien liegen
'  z. B. "C:\Eigene Dateien\"
Const verz = "c:\Matrix\Tableau\" ' Quellenordner
ChDir verz
With Application.FileSearch
.NewSearch
.LookIn = verz
.SearchSubFolders = True
.Filename = "*.xls"
.Execute
End With
'Mit jeder Datei ...
For i = 1 To Application.FileSearch.FoundFiles.Count
gesamt = Application.FileSearch.FoundFiles.Count
zahl = Range("A65002")
Application.StatusBar = ("Bearbeite Datensatz " & 1 + zahl & " von " & gesamt)
Set quelle = Workbooks.Open(Application.FileSearch.FoundFiles(i)) ' Öffnen
quelle = ActiveWorkbook.Name
Range("A65000") = ActiveWorkbook.Name
Range("A64999:A65000").Replace What:=".xls", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
nam = Range("A65000")
Range("A65000") = ""
Windows(ziel).Activate ' Zieldatei öffnen
Worksheets.Add.Move after:=Worksheets(Worksheets.Count) ' Neues Blatt ans Ende setzen und  _
Namen vergeben
ActiveSheet.Name = nam ' Name der Quelldatei
' Daten aus Quelldatei in Zieldatei kopieren
Windows(quelle).Activate
Cells.Copy
Windows(ziel).Activate
Cells.Select
ActiveSheet.Paste
Range("A1").Select
' Neues Blatt im Inhaltsverzeichnis eintragen
Sheets("Inhaltsverzeichnis").Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"'" & nam & "'!A1", TextToDisplay:=nam
Range("A65002") = zahl
Range("A65002") = zahl + 1
' Quelldatei schließen und keine Änderungen speichern
Windows(quelle).Close savechanges = no
Next i
Application.StatusBar = ("Bereit")
' Zieldatei speichern
Application.DisplayAlerts = True
ActiveWorkbook.Save
End Sub