VBA Zeilen übertragen

Guten Tag zusammen,

Ich würde gerne eine Vielzahl von Dateien (alle im gleichen Ordner) ansteuern und deren Inhalt in eine neue Datei (Datei_konsolidierung nennen wir sie mal) kopieren. Die Dateien sind alle gleich aufgebaut und sollen (so wie es sich gehört) zu einer (Datei_konsolidierung) vereint werden.
Jetzt sollte es natürlich so sein, dass wenn alle Zeilen der ersten Datei in die Datei_konsolidierung kopiert worden sind und die Zeilen aus der nächsten Datei angefügt werden sollen, der bereits bestehende Inhalt nicht überschrieben werden soll, sondern unten angefügt werden (wie sich jeder sicher denken kann =) ).

Jetzt müsste der Code so angepasst werden, das nicht immer nur Zeile 10 des jeweiligen Dokuments kopiert wird sondern alle Zeilen die Inhalt haben.

Crossposting:http://www.clever-excel-forum.de/thread-13983.html

Sub Sammeln()
sQuellpfad = "C:\Users\Felix.Bachert\Desktop\LN´s"
QZeile = 10 'Zeile in Quelldatei
QSpalten = 15 'Spaltenanzahl
QSpalteAb = "A" ' ab dieser Spalte insgesamt "QSpalten" Spaltenwerte übernehmen
ZZeile = 10 'erste Zeile in Zieldatei
ZSpalteAb = "A" 'erste Spalte in Zieldatei
Set wbGes = ActiveWorkbook
Set fso = CreateObject("Scripting.FileSystemObject")
For Each oFile In fso.GetFolder(sQuellpfad).Files
If LCase(Right(oFile.Name, 5)) = ".xlsx" Then 'nur ".xls"-Dateien verarbeiten; bei ".xlsx" natürlich die letzten 5 Zeichen vergleichen
Application.Workbooks.Open oFile.Path 'Quelldatei öffnen
'Zellen lt Vorgabe aus Quelldatei lesen und in aktuelle Zeile der Zieldatei schreiben
wbGes.Worksheets(1).Cells(ZZeile, ZSpalteAb).Resize(1, QSpalten).Value = ActiveWorkbook.Worksheets(1).Cells(QZeile, QSpalteAb).Resize(1, QSpalten).Value
ActiveWorkbook.Close False 'Quelldatei schließen
ZZeile = ZZeile + 1 'Zeilennummer Zieldatei erhöhen
End If
Next
wbGes.Save 'Zieldatei speichern
End Sub

Vielen Dank für Eure Hilfe vorab

Sub ChooseFilesAndCopy()
    Dim files As Variant, folder as String, file as String
    'Ordner  
    folder = "D:\Ordner"  
    file = Dir(folder & "\*.xlsx")  
        while file <> ""  
            'Datei auf Sheet 1 öffnen  
            With GetObject(folder & "\" & file).Sheets(1)  
                'Zelle A3:Q<ENDE> in die nächste freie Zelle in Spalte A kopieren  
                .Range("A3:Q" & .Cells(Rows.Count,"A").End(xlUp).Row).Copy ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)  
                'Sheet schließen  
                .Parent.Close False
            End With
        file = Dir
        wend
End Sub

file = Dir(folder & "\*.xls*")