3
Inhalt von Excel Dateien in einer Tabelle auflisten, zusammenführen
Hallo zusammen,
ich komme mit folgendem Problem nicht weiter und hoffe, dass mir jemand von euch sagen kann, was falsch ist:
Ich habe in einem Ordner mehrere Excel-Dateien.
Anforderung1.xlsx
Anforderung2.xlsx
Anforderung3.xlsx
Anforderung4.xlsx
etc.
Der Aufbau der Dateien ist immer gleich.
Es existiert immer nur eine Tabelle in jeder Datei.
Nun möchte ich den Ihnalt aus jeder Datei in EINER Ziel-Tabelle (AlleTabellenInEinerZusammenführen.xlsm) auflisten
Dazu soll das Makro wie folgt vorgehen:
a. lösche den alten Inhalt der Ziel-Tabelle
b. Öffne der Reihe nach jede .xlsx und
c. markiere die beschriebenen Zeilen, kopiere sie
d. gehe in die letzte beschriebene Zeile in Spalte B der Ziel-Tabelle und füge die kopierten Zeilen dort ein
Der unten stehende Code macht das zwar im Grunde auch.
Nur leider öffnet er nur die erste Datei (also Anforderung1.xlsx) und schreibt seinen Inhalt in die Ziel-Tabelle.
Was könnte hier falsch sein?
Danke im Voraus
ich komme mit folgendem Problem nicht weiter und hoffe, dass mir jemand von euch sagen kann, was falsch ist:
Ich habe in einem Ordner mehrere Excel-Dateien.
Anforderung1.xlsx
Anforderung2.xlsx
Anforderung3.xlsx
Anforderung4.xlsx
etc.
Der Aufbau der Dateien ist immer gleich.
Es existiert immer nur eine Tabelle in jeder Datei.
Nun möchte ich den Ihnalt aus jeder Datei in EINER Ziel-Tabelle (AlleTabellenInEinerZusammenführen.xlsm) auflisten
Dazu soll das Makro wie folgt vorgehen:
a. lösche den alten Inhalt der Ziel-Tabelle
b. Öffne der Reihe nach jede .xlsx und
c. markiere die beschriebenen Zeilen, kopiere sie
d. gehe in die letzte beschriebene Zeile in Spalte B der Ziel-Tabelle und füge die kopierten Zeilen dort ein
Der unten stehende Code macht das zwar im Grunde auch.
Nur leider öffnet er nur die erste Datei (also Anforderung1.xlsx) und schreibt seinen Inhalt in die Ziel-Tabelle.
Was könnte hier falsch sein?
Private Sub AlleTabellenblätterZusammenführen_Click()
Dim vntPfadUndDateiNamen As Variant
Dim strPfadUndDatei As String
Dim lngi As Long
Dim wbkMappe As Workbook
Dim wksTabelle As Worksheet
Dim wbkZiel As Workbook
Set wbkZiel = ThisWorkbook
Dim EndeQuelle As Long
Dim EndeZiel As Long
'Liste in der Zieltabelle leeren
ActiveSheet.Rows("4:10000").EntireRow.Select
Selection.ClearContents
'Dateien auswählen, die zusammengeführt werden sollen
vntPfadUndDateiNamen = Application.GetOpenFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Wählen Sie die Dateien für die Zusammenführung aus!", MultiSelect:=True)
If VarType(vntPfadUndDateiNamen) = vbBoolean Then
MsgBox "Vorgang wurde abgebrochen!"
Else
For lngi = LBound(vntPfadUndDateiNamen) To UBound(vntPfadUndDateiNamen)
strPfadUndDatei = vntPfadUndDateiNamen(lngi)
Set wbkMappe = Application.Workbooks.Open(strPfadUndDatei, ReadOnly:=True)
'Kopiere in der Quelldatei alle beschriebenen Zeilen ab Zeile 4
EndeQuelle = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
ActiveSheet.Rows("4:" & EndeQuelle).EntireRow.Select
Selection.Copy
'Füge die kopierten Zeilen in die Zieltabelle am Ende ein
wbkZiel.Activate
EndeZiel = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row + 1
ActiveSheet.Cells(EndeZiel, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.DisplayAlerts = False
wbkMappe.Close False
Next
End If
End SubDanke im Voraus
Share on Facebook
Share on Twitter
Share on Reddit
Share on LinkedinPlease also mark the comments that contributed to the solution of the article
Content-Key: 1096794256
Url: https://administrator.de/contentid/1096794256
Printed on: April 24, 2024 at 14:04 o'clock
3 Comments
Latest comment
Sub FilesImportieren()
Dim files As Variant, file As Variant
Application.DisplayAlerts = False
files = Application.GetOpenFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Wählen Sie die Dateien für die Zusammenführung aus!", MultiSelect:=True)
If TypeName(files) = "Boolean" Then
MsgBox "Vorgang wurde abgebrochen!"
goto Ende
End If
For Each file In files
With GetObject(file).Sheets(1)
.UsedRange.Copy
ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Parent.Close False
End With
Next
Ende:
Application.DisplayAlerts = True
End Sub
Hallo Evopus,
vielen Dank für die schnelle Antowort.
Die xlsx sollen aber immer erst ab Zeile 4 bis zum letzten Eintrag ausgelesen werden.
Daher kann ich mit .UsedRange.Copy nicht arbeiten.
Wie müsste ich diesen Code ändern?
.Rows("4:" & EndeQuelle).EntireRow.Select funktioniert hier nicht.
Danke
vielen Dank für die schnelle Antowort.
Die xlsx sollen aber immer erst ab Zeile 4 bis zum letzten Eintrag ausgelesen werden.
Daher kann ich mit .UsedRange.Copy nicht arbeiten.
Wie müsste ich diesen Code ändern?
.Rows("4:" & EndeQuelle).EntireRow.Select funktioniert hier nicht.
Danke
Hallo
ich habe es jetzt so gelöst
.Range("A4:AZ" & ActiveSheet.UsedRange.Rows.Count).Copy
eigentlich hätte mir gereicht, wenn die ganzen Zeilen der UsedRange kopiert würden (anstatt A4:AZ).
ich habe es jetzt so gelöst
.Range("A4:AZ" & ActiveSheet.UsedRange.Rows.Count).Copy
eigentlich hätte mir gereicht, wenn die ganzen Zeilen der UsedRange kopiert würden (anstatt A4:AZ).
