vor kurzem hatte ich folgende Anfrage hier ins Forum gestellt:
________________________________________________________________________________________________________________________________________________________________
ich habe mehrere Dateien mit je einem Tabellenblatt. Alle sind genau gleich aufgebaut. Eine davon ist die Übersichtstabelle.
Jetzt sollen die Daten (nur die gefüllten Zeilen) jedes einzelnen Blattes der Reihe nach abgefragt und in die Übersichtstabelle kopiert werden.
Bedingungen/Anmerkungen:
- der Kopf (Zeile 1+2) ist überall gleich und bleibt "unberührt"
- die Anzahl der zu kopierenden Zeilen aus den Einzelblättern ist unterschiedlich
- zwischen jedem "Block" (=Daten eines Einzelblattes) sollte eine Leerzeile eingefügt werden
- Die Tabellen haben in den Spalten A+B nur Text stehen, die Spalten C bis BN sind 'leer', aber mit unterschiedlichen Farben (Füllfarbe) markiert. Alles, Text und Füllfarben müssen übernommen werden."
________________________________________________________________________________________________________________________________________________________________
Daraufhin habe ich (von Dani) auch eine perfekte Lösung erhalten:
================================================================================================================================================================
Hallo Matthias,
die folgende Prozedur könnte als Ansatz dienen:
Sub Dataextract()
Dim Listenlänge, i, z As Long
Dim Pfad, File As String
Pfad = "C:\Suchpfad eingeben...\"
File = Dir(Pfad)
z = 3
Do
If Not File = "Übersicht.xls" Then
Workbooks.Open Pfad & File
Listenlänge = Workbooks(File).Worksheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row 'Spalte A länge ermitteln
Workbooks(1).Worksheets("Tabelle1").Activate
Workbooks(File).Worksheets("Tabelle1").Range("A3:BN" & Listenlänge).Copy Destination:=ThisWorkbook.Worksheets("Tabelle1").Range("a" & z)
z = z + Listenlänge - 1
Workbooks(File).Close SaveChanges:=False
End If
File = Dir()
Loop Until File = ""
End
Sub
Du musst dazu die zu extraktierenden Files in einen gemeinsamen Ordner verschieben und dieses Makro starten. Ich hoffe das hilft dir.
Gruss Dani
Nun muss ich aber mein "Projekt" wie folgt erweitern:
- es sollen in den Einzelblättern jeweils nur soviel Zeilen kopiert werden, bis eine Leerzeile kommt. Die Anzahl Zeilen ist aber nach wie vor variabel.
Alle beschriebenen Zeilen unterhalb der Leerzeile sollen dann nicht mit kopiert werden.
Wie kann ich dies im oben gezeigten Makro ergänzen?
Desweiteren gibt es noch folgende "Probleme":
- Wenn beim Ausführen des Makros eine der Einzelblätter-Dateien geändert wurde und noch nicht abgespeichert ist
oder ein anderer User eine dieser Dateien offen hat, gibt es eine Fehlermeldung und das Makro muss abgebrochen werden.
Kann man dies abfangen und wenn ja, wie?
Besten Dank für Eure Hilfe!
Gruss
Matthias