VBA Mehrere Arbeitsblätter zu einem Zusammenführen

Sub Vereinigung()
Call ListFilesInFolder("c:\Irgendwas")
End Sub

Sub ListFilesInFolder(SourceFolderName As String)

Dim SourceFolder As Object, SubFolder As Object, nextsheet

Dim Datei$, Pfad$, DateiMatch$

Dim AnfZelle As Range, Wb As Workbook, datensatz As Worksheet, lo As ListObject, mainLO As   _

_

ListObject, col As ListRow

Dim counter As Integer

On Error Resume Next

Set SourceFolder = CreateObject("Scripting.FileSystemObject").GetFolder(SourceFolderName)

Set datensatz = Worksheets("Datensatz") 'welches Arbeitsblatt sollen die Daten  _

zwischengespeichert werden

Set ergebnis = Worksheets("Ergebnis")   'welches Arbeitsblatt für die Erstellung der Liste

datensatz.Cells.ClearContents           'Zellen im Arbteitsblatt leeren

Dateiname$ = "datenpool.xls" 'Dateinamen

nextsheet = Dir(SourceFolder.Path & "\" & Dateiname$)

counter = 1

Set AnfZelle = datensatz.Range("A" & counter) '
_

aktiven Arb.Mappe

Do While nextsheet  ""

Workbooks.Open SourceFolder.Path & "\" & nextsheet

ActiveWorkbook.Worksheets("Sheet1").Range("A1:A6").Copy Destination:=AnfZelle

ActiveWorkbook.Close SaveChanges:=False     

nextsheet = Dir()

counter = counter + 1

Loop

For Each SubFolder In SourceFolder.SubFolders

ListFilesInFolder SubFolder.Path

Next SubFolder

Set SourceFolder = Nothing

Set SubFolder = Nothing

End Sub