Sammeltabelle - Daten (Zeilen) aus einem Ordner welcher über 300 Tabellen verfügt in einer Tabelle sammeln.

Hallo zusammen,

auf der Arbeit benötige ich um effektiver arbeiten zu können eine Sammeltabelle.

Ich vermute das ganze wird über Makro laufen, aber da ich in diesem Bereich ein Neuling bin, bitte ich euch um Hilfe

Nun zu meinem "Problem":

- Ich benötige aus einem Ordner alle Excel-Tabellen in einer Tabelle per Knopfdruck eingesammelt.
Quellordner: F:\_Sublisten1

- Aus den Tabellen benötige ich alle Zeilen ab der Zeile 9 (Zeilen Anzahl variiert von 3-150)

- Alle Tabellen sind von den Spalten gleich eingeteilt

Dürfte nicht schwer sein?! Aber für mich schon... Daher wäre eine Beispieldatei bei der ich nur auf ein Knöpf drücken müsste nett

Habe alle Foren durchsucht aber nie genau diesen Fall gefunden. Wäre super wenn Ihr mir hier helfen könntet!

Vielen Dank!!!!

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 184917

Url: https://administrator.de/forum/sammeltabelle-daten-zeilen-aus-einem-ordner-welcher-ueber-300-tabellen-verfuegt-in-einer-tabelle-sammeln-184917.html

Ausgedruckt am: 22.04.2025 um 17:04 Uhr

11 Kommentare

Neuester Kommentar

Hallo yeshaya und willkommen im Forum!

Habe alle Foren durchsucht aber nie genau diesen Fall gefunden.

Vielleicht helfen Dir aber ähnliche Fälle (und da war noch nicht mal Dieter beteiligt

):
mehrer Excel Tabellen mit mehreren Blättern zusammenführen
mehrere Exceldateien in eine Excel Datei zusammenfassen
Makro zum transponieren von Daten aus mehreren Dateien in eine Sammeldatei
Inhalte aus Excel-Dateien in Sammeldokument kopieren mittels Makro?

Da ich momentan nicht gerade viel Zeit erübrigen kann [Edit] "viel" ist relativ [/Edit] , versuch doch erst mal selbst, etwas daraus zu basteln (und falls Du dann noch weitere Unterstützung benötigst, erkläre mal genauer, wie zB die Anzahl "3-150" zu ermitteln wäre) ...

Grüße
bastla

Hallo Bastla, danke fürs antworten.

Habe diese Seiten auch schon durchgeschaut, nur sind hier ja einzelne Zellen, oder einzelne Zeilen gemeint. Und da komm ich einfach nicht weiter

Mit Zeilen Anzahl 3-150 meine ich das ab Zeile 9 nur 3 Zeilen belegt sein können, sprich Zeile 9-12. Aber in einer anderen Tabelle wieder rum 9-97 belegt sein können.

Denke das einfachste wäre einfach zu sagen die Sammeltabelle soll von allen Exceltabellen aus diesem Pfad die Zeilen 9-150 ziehen. (Falls notwendige Angabe Spalten A-J)
Denn dann kann ich die Sammeltabelle nach Datum sortieren und die leeren Zeilen fallen mir automatisch unten raus...

also nochmals kurz zusammengefasst:

aus einem bestimmten Pfad
aus allen Excel Tabellen in dem Ordner
Zeilen 9-150 Spalte A-J

Ich hoffe mir kann jemand helfen =)

Hallo yeshaya!

Unter der Annahme, dass aus dem jeweils ersten Tabellenblatt jeder Datei Daten aus allen Zeilen (ab Zeile 9) übernommen werden sollen, bis in Spalte A kein Wert mehr steht, ungetestet etwa so:

Sub Sammeln()
sQuellpfad = "F:\_Sublisten1"  

QZeileAb = 9 'Ab dieser Zeile in Quelldatei Daten übernehmen  
QSpalten = 10 'Spaltenanzahl (A-J)  
QSpalteAb = "A" ' ab dieser Spalte insgesamt "QSpalten" Spaltenwerte übernehmen  

ZZeile = 2 '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(Left(fso.GetExtensionName(oFile.Name), 3)) = "xls" Then 'nur ".xls*"-Dateien verarbeiten  
        Application.Workbooks.Open oFile.Path 'Quelldatei öffnen  
        QZeile = QZeileAb 'Startzeile der Quelldatei setzen  
        Do While ActiveWorkbook.Worksheets(1).Cells(QZeile, QSpalteAb).Value <> "" 'Daten übernehmen, wenn in erster Spalte ein Wert steht, ansonsten Datei fertig  
            wbGes.Worksheets(1).Cells(ZZeile, ZSpalteAb).Resize(1, QSpalten).Value = ActiveWorkbook.Worksheets(1).Cells(QZeile, QSpalteAb).Resize(1, QSpalten).Value
            QZeile = QZeile + 1 'Zeilennummer Quelldatei erhöhen  
            ZZeile = ZZeile + 1 'Zeilennummer Zieldatei erhöhen  
        Loop
        ActiveWorkbook.Close False 'Quelldatei schließen  
    End If
Next

wbGes.Save 'Zieldatei speichern  
End Sub

Die Sammeldatei darf nicht im Ordner "F:\_Sublisten1" liegen, da sie sich ansonsten "selbst verarbeiten" würde ...

Falls Du das wirklich auf die Zeilen 9 bis 150 fixieren wolltest, dann:

Sub Sammeln()
sQuellpfad = "F:\_Sublisten1"  

QZeileAb = 9 'Ab dieser Zeile in Quelldatei Daten übernehmen  
QZeileBis = 150 'Bis zu dieser Zeile in Quelldatei Daten übernehmen  
QSpalten = 10 'Spaltenanzahl (A-J)  
QSpalteAb = "A" ' ab dieser Spalte insgesamt "QSpalten" Spaltenwerte übernehmen  

ZZeile = 2 '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(Left(fso.GetExtensionName(oFile.Name), 3)) = "xls" Then 'nur ".xls*"-Dateien verarbeiten  
        Application.Workbooks.Open oFile.Path 'Quelldatei öffnen  
        For QZeile = QZeileAb To QZeileBis
            wbGes.Worksheets(1).Cells(ZZeile, ZSpalteAb).Resize(1, QSpalten).Value = ActiveWorkbook.Worksheets(1).Cells(QZeile, QSpalteAb).Resize(1, QSpalten).Value
            ZZeile = ZZeile + 1 'Zeilennummer Zieldatei erhöhen  
        Next
        ActiveWorkbook.Close False 'Quelldatei schließen  
    End If
Next

wbGes.Save 'Zieldatei speichern  
End Sub

bzw schneller

Sub Sammeln()
sQuellpfad = "F:\_Sublisten1"  

QZeileAb = 9 'Ab dieser Zeile in Quelldatei Daten übernehmen  
QZeilen = 150 'Anzahl Zeilen aus Quelldatei übernehmen  
QSpalten = 10 'Spaltenanzahl (A-J)  
QSpalteAb = "A" ' ab dieser Spalte insgesamt "QSpalten" Spaltenwerte übernehmen  

ZZeile = 2 '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(Left(fso.GetExtensionName(oFile.Name), 3)) = "xls" Then 'nur ".xls*"-Dateien verarbeiten  
        Application.Workbooks.Open oFile.Path 'Quelldatei öffnen  
        wbGes.Worksheets(1).Cells(ZZeile, ZSpalteAb).Resize(QZeilen, QSpalten).Value = ActiveWorkbook.Worksheets(1).Cells(QZeile, QSpalteAb).Resize(QZeilen, QSpalten).Value
        ZZeile = ZZeile + QZeilen 'Zeilennummer Zieldatei erhöhen  
        ActiveWorkbook.Close False 'Quelldatei schließen  
    End If
Next

wbGes.Save 'Zieldatei speichern  
End Sub

Grüße
bastla

[Edit] Jeweils fehlendes "s" nachgetragen [/Edit]

@bastla

Vielleicht helfen Dir aber ähnliche Fälle (und da war noch nicht mal Dieter beteiligt ):

Na, dann gebe ich doch wenigstens hier meinen Senf dazu

Du solltest Dich eventuell noch für "Quellpfad" oder "sQuellpfad" entscheiden

Noch einen schönen Sonntag!

Gruß Dieter

ha es funktioniert nun auch so wuhu vielen lieben dank und ja dieter das hab i au rausgefunde xD

danke danke danke schoenen abend noch!!

Hallo Dieter!

Danke für die Geschmacksverbesserung - ich hatte nur mal eben (dieses Mal bei mir selbst

) "geborgt" ...

Grüße und auch einen schönen Wochendrest
bastla

Hallo yeshaya!

Freut micht, wenn's passt.

Grüße
bastla

P.S.: Du könntest noch einen dieser erfreulichen (grünen) Haken an den Thread machen ...

Hallo,

nochmals vielen Dank für den sehr anschaulichen Code.

Ich habe jetzt den Fall, dass die Dateien, die aufgerufen werden, allesamt mit demselben Passwort geschützt sind.
Leider habe ich es bisher noch nicht hinbekommen, das Passwort im Makro so zu hinterlegen, damit es automatisch eingegeben werden kann, oder Usereingriff.

Hat mir hier vielleicht jemand einen Tipp?

Vielen Dank schon mal vorab für eure Hilfe!

Gruß
L.

Hallo Mr-Lanzelot!

Falls das Passwort zum Öffnen der Arbeitsmappe gemeint ist, dann so:

Application.Workbooks.Open oFile.Path, Password:="Passwort"

oder einmaliger Eingabe per InputBox (sichtbar) vor der For-Each-Schleife:

Sub Sammeln() 
    '....  
    
    sPassword = Application.InputBox("Bitte Passwort eingeben:", "Passwort...", Type:=2)  
    
    If sPassword = "" Then  
        MsgBox "Abbruch: Passwort ungültig!", vbExclamation, "Passwort...":  Exit Sub  
    End If
    
    '....  
    
    For Each oFile In fso.GetFolder(sQuellpfad).Files 
        '....         
       Application.Workbooks.Open oFile.Path, Password:=sPassword