Daten aus mehreren Excel Dateien in eier Neuen Datei zusammenfügen

Hallo ich habe in einen Ordner sehr viele Excel Darein mit denselben Aufbau, und es kommen täglich welche dazu.
Die Exceldateien heißen immer anders. Nun möchte ich eine Excel Datei haben in der aus allen Dateien bestimmte Daten in einer art Liste zusammen geführt werden.

Beispiel: in jeder Datei, Zelle B3 steht der Vereinsname, in Zelle A9 der Name, C9 der Vorname und E9 die Spielernummer.
Dieses geht weiter bis A22, C22, E22. Das heißt es können bis zu 14 Namen in der Datei stehen.
Siehe Bild1


Diese Daten sollen in eine Unformatierte Datei eingefügt werden.
Siehe Bild2

Da nicht bei allen Mannschaften 14 Namen in der Datei vorhanden sind, sollten nicht die leeren Daten übertragen werden.
Der Vereinsname sollte immer vor jeden Namen erscheinen.

Ich hoffe ihr versteht was ich meine und könnt mir helfen.

Gruß Magoo200

Dim fs, f, f1, fc, s
Set fs = CreateObject("Scripting.FileSystemObject")  
Set f = fs.GetFolder("c:\excel\")  
Set fc = f.Files

Dim a, b

a = 0

For Each f1 In fc
    
  Workbooks.Open "c:\excel\" & f1.Name  

  Dim Ziel, Quelle As Worksheet

  Set Ziel = Workbooks.Item(1).Worksheets(1)
  Set Quelle = Workbooks.Item(2).Worksheets(1)

  b = 0
  
  While Quelle.Cells(b + 9, 1) <> ""  
    
    Ziel.Cells(a, 1) = Quelle.Cells(3, 2)
    Ziel.Cells(a, 2) = Quelle.Cells(b + 9, 1)
    Ziel.Cells(a, 3) = Quelle.Cells(b + 9, 3)
    Ziel.Cells(a, 4) = Quelle.Cells(b + 9, 5)
    b = b + 1
    a = a + 1
    
  Wend

  Set Ziel = Nothing
  Set Quelle = Nothing

  Workbooks.Item(2).Close (False)

Next

Private Sub CommandButton1_Click()
Dim fs, f, f1, fc, s
Set fs = CreateObject("Scripting.FileSystemObject")  
Set f = fs.GetFolder("C:\Liga 2006\Teamkarten\")  
Set fc = f.Files

Dim a, b

a = 1    '  < hier war auch noch ein Fehler  

For Each f1 In fc
    
  Workbooks.Open "C:\Liga 2006\Teamkarten\" & f1.Name  

  Dim Ziel, Quelle As Worksheet

  Set Ziel = Workbooks.Item(1).Worksheets(1)
  Set Quelle = Workbooks.Item(2).Worksheets(1)

  b = 0
  
  While Quelle.Cells(b + 9, 1) <> ""  
    
    Ziel.Cells(a, 1) = Quelle.Cells(3, 2)
    Ziel.Cells(a, 2) = Quelle.Cells(b + 9, 1)
    Ziel.Cells(a, 3) = Quelle.Cells(b + 9, 3)
    Ziel.Cells(a, 4) = Quelle.Cells(b + 9, 5)
    b = b + 1
    a = a + 1
    
  Wend

  Set Ziel = Nothing
  Set Quelle = Nothing

  Workbooks.Item(2).Close (False)

Next
End Sub