Habe die Lösung Trotzdem danke:
Sub Zuss()
Dim fs, F, f1, fc, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set F = fs.GetFolder("D:\Sammulng\")
Set fc = F.Files
Dim a, b
Dim lngCounter As Long
Dim wbOrig As Workbook
Dim wbTarg As Workbook
a = 0
For Each f1 In fc
Workbooks.Open "D:\Sammulng\" & f1.Name
Dim Ziel, Quelle As Worksheet
Set Ziel = Workbooks.Item(1).Worksheets(1)
Set Quelle = Workbooks.Item(2).Worksheets(1)
Set wbOrig = Workbooks.Item(2)
Set wbTarg = Workbooks.Item(1)
For lngCounter = 1 To Workbooks.Item(2).Sheets.Count
Workbooks.Item(2).Sheets(lngCounter).Copy After:=Workbooks.Item(1).Sheets(wbTarg.Sheets.Count)
Next lngCounter
Set wbTarg = Nothing
Set wbOrig = Nothing
Set Ziel = Nothing
Set Quelle = Nothing
Workbooks.Item(2).Close (False)
Next