Makro zum transponieren von Daten aus mehreren Dateien in eine Sammeldatei

Hallo allerseits,

da meine Kenntnisse mit VBA nicht wirklich ausgereift sind, hier mal mein Problem. Ich denke dass es über ein Makro zu realisieren ist, aber über das wie tappe ich noch im Dunkeln...

Ich hab eine Ansammlung von Dateien, die alle identisch aufgebaut sind, aus denen ich Daten (Werte, nicht die Formeln, vertikal angeordnet) in eine Excelsammeldatei transponoieren will (horizontale Anordnung).
In meiner Sammeldatei sind schon Daten erfasst, die um einige Werte aus den identischen Dateien ergänzt werden sollen. Ich habe mir das fogendermaßen vorgestellt:
In der Sammeldatei sind in der Spalte C (z.b Artikelnummern) eingetragen zu denen in den Spalten D-K Informationen eingetragen sind. Nun sollen also zu jedem Artikel ab der Spalte L die Daten ergänzt werden. In den Quelldateien ist immer in der Zelle B2 die Artikelnummer eingetragen und in den Zellen D5 - D10 die Werte (teilweise durch Formeln berechnet), die ich in meine Sammeldatei transponieren will. Das Makro sollte wie folgt vorgehen:

1. Schriit: Prüfen ob in meiner Sammeldatei z.B. in Zelle C5 eine Artikel-Nr vorhanden ist, wenn ja > 2. Schritt / wenn nein > Ende
2. Schritt: Prüfen ob Zelle L5 leer ist. wenn nein > Schritt 1 für die nächste Zeile (C6) / wenn ja > 3. Schritt
3. Schritt: Prüfen ob zu der Artikel-Nr aus z.B Zelle C5 eine Quelldatei existiert. Also prüfen ob in einer der .xls Quelldateien meines Ordners in der Zelle B2 die gesuchte Artikel-Nr eingetragen ist. wenn nein > Schritt 1 für die nächste Zeile / wenn ja > 4. Schritt
4. Schritt: Transponieren der Daten aus den Zellen D5-D10 aus der gefundenen Datei in meine Sammeldatei in die Zellen L5-Q5 (Zeile der geprüften Artikel-Nr.) danach wieder 1. Schritt

Wie schon gesagt, denke ich dass es machbar ist (falls ich mich irre lasse ich mich da gerne eines besseren belehren , nur bekomme ich das im VBA nicht in den Griff...

Falls mir jemand helfen kann schon mal vielen Dank im Voraus!

Viele Grüße
Rio

Sub CollectAndTrans()
Ordner = "D:\Test"  

Dim A()
Set d = CreateObject("Scripting.Dictionary")  
Set fso = CreateObject("Scripting.FileSystemObject")  

For Each File In fso.GetFolder(Ordner).Files
    If UCase(fso.GetExtensionName(File.Name)) = "XLSX" Then  
        Set WB = Workbooks.Open(File.Path)
        ReDim A(5) 'Array passend dimensionieren und dabei löschen  
        i = 0 'Index für Array initialilsieren  
        For Each Cell In WB.Worksheets(1).Range("D5:D10")  
            A(i) = Cell.Value 'Zellwert in Array übernehmen  
            i = i + 1
        Next
        'Jede ArtNr kommt nur einmal vor, daher keine Prüfung des Keys erforderlich -  
        'Artikel kann dem Dictionary hinzugefügt werden  
        d.Add CStr(WB.Worksheets(1).[B2]), A
        WB.Close
    End If
Next

R = 5 'ab Zeile 5 der Sammeltabelle  
ArtNr = CStr(Cells(R, "C"))  
Do Until ArtNr = "" 'bis keine Artikeldaten mehr gefunden werden  
    If Cells(R, "L") = "" Then  
        If d.Exists(ArtNr) Then Cells(R, "L").Resize(1, 6).Value = d.Item(ArtNr)  
    End If
    R = R + 1
    ArtNr = CStr(Cells(R, "C"))  
Loop
End Sub

If d.Exists(ArtNr) Then Cells(R, "L").Resize(1, UBound(d.Item(ArtNr)) + 1).Value = d.Item(ArtNr)