Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1920to1924
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Bereiche aus verschiedenenDateien

Bereiche aus verschiedenenDateien
06.03.2023 11:37:27
Felix
Hallo zusammen,
nachdem ich jetzt vieles hin- und her versucht habe komme ich nicht wirklich zu einem Ergebnis das ich gerne hätte.
Ich habe einen Ordner in dem mehrere Excel Dateien abgespeichert werden.
Diese Dateien enthalten Überschriften und Messwerte.
Ich hätte gerne aus jeder Datei den Wert aus Zelle B2 als Überschrift und dann die gefüllten Zeilen von A19:D19 bis zur letzten gefüllten Zeile.
Das kann mal die Zeile 25 sein, aber auch mal Zeile 300.
Und diese dann in eine neue Datei in ein Tabellenblatt untereinander.
Bin um jede Hilfe dankbar :-)

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bereiche aus verschiedenenDateien
06.03.2023 21:50:54
Yal
Hallo Felix,
mal sehen, ob Du damit glücklich wird:
Sub Daten_sammeln()
'Unter Anbindung (VB, Extras, Verweise...) von Microsoft Scripting Runtime
Dim FSO As New FileSystemObject
Dim ws As Worksheet
Dim F As File
Dim R As Range
    With Workbooks.Add.Worksheets(1)
        For Each F In FSO.GetFolder("C:\Temp\H_forum").Files
            If InStr(1, F.Type, "Excel-Arbeitsblatt") Then
                Set ws = Workbooks.Open(F.Path).Worksheets(1)
                With .Cells(Rows.Count, 2).End(xlUp)
                    .Offset(1, -1) = ws.Range("B2").Value
                    Set R = Range(ws.Range("D19"), ws.Cells(Rows.Count, 1).End(xlUp))
                    .Offset(1, 0).Resize(R.Rows.Count, R.Columns.Count) = R.Value
                End With
            End If
        Next
    End With
End Sub
Ungetestet (womit auch?)
Idealerweise zuerst Schritt Für Schritt laufen lassen, oder Du machst ein separaten Verzeichnis nur wenig Dateien, zum Testen.
VG
Yal
Anzeige
AW: Bereiche aus verschiedenenDateien
07.03.2023 08:29:34
Felix
Hallo Yal,
vielen Dank schon einmal für die schnelle Antwort.
Leider überspringt er die IF Anweisung - mit "Excel-Arbeitsblatt" ist doch der Name des Worksheets aus den Dateien gemeint, oder? Die heißen immer "Tabelle1" und es gibt auch nur diese eine Tabelle in den Dateien.
Aber auch wenn ich das eintrage überspringt er IF und geht direkt zum nächsten über.
Ja womit auch... Hier eine der Dateien: https://www.herber.de/bbs/user/158146.xls
Schönen Gruß
Felix
AW: Bereiche aus verschiedenenDateien
07.03.2023 08:46:48
Felix
Hallo nochmal,
es musste einfach nur "Excel" heißen und nicht "Excel-Arbeitsblatt" dann funktioniert es.
Sieht schon mal sehr gut aus!
Vielen Dank!
VG Felix
Anzeige
AW: Bereiche aus verschiedenenDateien
07.03.2023 08:55:53
Felix
Und noch einmal Hallo :-)
Was müsste ich denn tun damit der Wert aus b2 vor jeder Zeile steht - nicht nur einmal oben drüber?
Ich glaube dann wäre es zum Sortieren und Tabellenfilter einrichten einfacher...
VG Felix
AW: Bereiche aus verschiedenenDateien
07.03.2023 09:11:46
Yal
Hallo Felix,
man ermittelt erneut die letztbefüllte Zelle in Spalte B. Von der eine Spalte nach link ("-1") befindende Zelle bis die nach oben nächstbefüllte Zelle wird einen "Filldown" (in Excel mit Strg+u zu haben) gemacht.
Sub Daten_sammeln()
'Unter Anbindung (VB, Extras, Verweise...) von Microsoft Scripting Runtime
Dim FSO As New FileSystemObject
Dim ws As Worksheet
Dim F As File
Dim R As Range
   
    With Workbooks.Add.Worksheets(1)
        For Each F In FSO.GetFolder("C:\Temp\H_forum").Files
            If InStr(1, F.Type, "Excel") Then
                Set ws = Workbooks.Open(F.Path).Worksheets(1)
                With .Cells(Rows.Count, 2).End(xlUp)
                    .Offset(1, -1) = ws.Range("B2").Value
                    Set R = Range(ws.Range("D19"), ws.Cells(Rows.Count, 1).End(xlUp))
                    .Offset(1, 0).Resize(R.Rows.Count, R.Columns.Count) = R.Value
                End With
                With .Cells(Rows.Count, 2).End(xlUp)
                    Range(.Offset(0, -1), .Offset(0, -1).End(xlUp)).FillDown
                End With
            End If
        Next
    End With
End Sub
VG
Yal
Anzeige
AW: Bereiche aus verschiedenenDateien
07.03.2023 09:30:54
Felix
Hallo Yal,
vielen Dank, aber seltsamerweise springt er - bei mir - jetzt mit Laufzeitfehler 1004 bei der Zeile "Set R = Range(ws.Range("D19"), ws.Cells(Rows.Count, 1).End(xlUp))" raus.
Die ist aber doch gar nicht verändert...?
Hast Du eine Idee dazu?
VG Felix
AW: Bereiche aus verschiedenenDateien
07.03.2023 09:45:53
Yal
Hallo Felix,
sind deine Quelledatei alle von dieselbe/neueste Excel-Vesion oder hast einige alte Excel?
Verusche mit
Set R = Range(ws.Range("D19"), ws.Cells(ws.Rows.Count, 1).End(xlUp))
ohne den "ws" wird Rows.Count aus dem aktuell aktiven Blatt gelesen und ist bei 365 1.048.576. Beim manche alten Excel ist es aber 65.536.
Eigentlich wenn Du immer sicher bist, dass Du nie so viele Daten in der Quelle hast, kannst Du
Set R = Range(ws.Range("D19"), ws.Cells(65000, 1).End(xlUp))
verwenden.
VG
Yal
Anzeige
AW: Bereiche aus verschiedenenDateien
07.03.2023 10:06:14
Felix
Hallo Yal,
die Quelldateien sind alles "ältere" xls Dateien.
Ich habe es mit beiden getestet, aber der Fehler bleibt. Komischerweise hat es am Anfang ja funktioniert.
Kann es sein das ich mich vertan habe und er die Zeile danach meint?
Hier mal mein ganzer Code:
Sub Daten_sammeln()
'Unter Anbindung (VB, Extras, Verweise...) von Microsoft Scripting Runtime
Dim FSO As New FileSystemObject
Dim ws As Worksheet
Dim F As File
Dim R As Range
   
    With Workbooks.Add.Worksheets(1)
        For Each F In FSO.GetFolder("C:\Excel2").Files
            If InStr(1, F.Type, "Excel") Then
                Set ws = Workbooks.Open(F.Path).Worksheets(1)
                With .Cells(Rows.Count, 2).End(xlUp)
                    .Offset(1, -1) = ws.Range("B2").Value
                    Set R = Range(ws.Range("D19"), ws.Cells(65000, 1).End(xlUp))
                    .Offset(1, 0).Resize(R.Rows.Count, R.Columns.Count) = R.Value
                End With
                With .Cells(Rows.Count, 2).End(xlUp)
                    Range(.Offset(0, -1), .Offset(0, -1).End(xlUp)).FillDown
                End With
            End If
        Next
    End With
End Sub
VG Felix
Anzeige
AW: Bereiche aus verschiedenenDateien
07.03.2023 11:13:06
Yal
Hallo Felix,
kann ich nicht nachvollziehen. Manchmal verzettelt sich VBA. Excel neustarten und nochmal laufen lassen.
VG
Yal
AW: Bereiche aus verschiedenenDateien
07.03.2023 12:03:48
Felix
Hallo Yal,
okay, dann muss es ja hier irgendwo dran liegen.
Selbst nach einem PC Neustart kam der Fehler wieder - aber ich schaue mal weiter.
Aber ich habe ja zuerst gesehen das es läuft...
Vielen Dank nochmal für Deine Unterstützung!
VG Felix

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige