Excel Datei - Werte per Macro auslesen

Sub Zusammenfassen()
QSVon = "B" 'erste zu übertragende Spalte der Quelltabelle  
QSBis = "D" 'letzte zu übertragende Spalte der Quelltabelle  
QSKrit = "D" 'Spalte der Quelltabelle, welche als Kriterium herangezogen wird  
QZVon = 5 'erste zu übertragende Zeile der Quelltabelle  
Set ZT = Worksheets("Zusammenfassung") 'Name der Zieltabelle  
ZS = "A" 'Spalte, ab welcher die Daten in die Zieltabelle geschrieben werden sollen  
ZZ = 2 'Zeile, ab welcher die Daten in die Zieltabelle geschrieben werden sollen  

ZSAnz = Range(Cells(1, QSVon), Cells(1, QSBis)).Columns.Count ' Anzahl der zu übertragenden Spalten ermitteln  

For i = 5 To 14 'lfd Tabellennummern der Quelltabellen (alternativ: Array mit den Namen der Quelltabellen verwenden)  
    QZ = QZVon 'in Zeile, ab welcher aus der jeweiligen Quelltabelle Daten übernommen werden sollen, starten  
    With Worksheets(i) 'Quelltabelle  
        Do While .Cells(QZ, QSKrit).Value <> "" 'Schleife, solange in der Kriterienspalte noch Daten vorhanden sind  
            If .Cells(QZ, QSKrit).Value > 1 Then 'hier das Kriterium (">1") festlegen  
                Daten = .Range(.Cells(QZ, QSVon), .Cells(QZ, QSBis)).Value 'Werte aus der Quelltabelle in Array übertragen  
                ZT.Cells(ZZ, ZS).Resize(1, ZSAnz) = Daten 'Array in Zieltabelle schreiben  
                ZZ = ZZ + 1 'nächste Zeile der Zieltabelle festlegen  
            End If
            QZ = QZ + 1 'nächste Zeile der Quelltabelle festlegen  
        Loop
    End With
Next
End Sub