Mastertabelle

Hallo liebe Community,
ich wäre zutiefst dankbar, wenn mir jemand von Euch weiterhelfen könnte.
Ich möchte gerne per Makro alle Daten der SAP-Exporte: (hier mal 2 Beispieldateien)
https://www.herber.de/bbs/user/98604.xlsx
https://www.herber.de/bbs/user/98603.xlsx
auslesen lassen und in eine "Mastertabelle" untereinander aufgelistet haben.

Die Datei https://www.herber.de/bbs/user/98602.xlsx wurde aus Datenschutzgründen gelöscht

Hierbei muss bedacht werden, dass es durchaus viele SAP-Exporte werden können, die jeweils für sich unterschiedlich umfangreich bzgl. der Zeilen sind.
Leider reichen meine VBA-Kenntnisse nicht aus, um allein eine Lösung zu finden, deshalb setze ich auf Euch. Mir wurde bisher hier bei meinen Problemen immer zuverlässig weitergeholfen. Tausend Dank bereits jetzt!!
Beste Grüße.
Eric

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub alle_Dateien_Verzeichnis() Dim TB1, TB2, LR1&, LR2& Dim Pfad$, Ext$, Datei$ Set TB1 = ActiveSheet Pfad = ThisWorkbook.Path & "\" Ext = "*.xlsx" Datei = Dir(Pfad & Ext) Do While Len(Datei) > 0 Workbooks.Open Filename:=Pfad & Datei Set TB2 = ActiveSheet LR1 = TB1.Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile der Spalte LR2 = TB2.Cells(Rows.Count, 1).End(xlUp).Row TB2.Rows("2:" & LR2).Copy TB1.Rows(LR1 + 1) Workbooks(Datei).Close SaveChanges:=False Datei = Dir() ' nächste Datei Loop End Sub

Hallo nochmal
Füge bitte in der Tabelle in AS1 dei Überschrift für den Dateinamen ein.
Die letzte Spalte wird nämlich ermittelt.
Auch lasse ich die Dateiextension .xls weg
Ich hab noch eine Reset eingebaut. kannst du rausnehmen, wenn du ihn nicht brauchst.

 Sub alle_Dateien_Verzeichnis()
Dim TB1, TB2, LR1&, LR2&, LC%
Dim Pfad$, Ext$, Datei$
Set TB1 = ActiveSheet
Pfad = ThisWorkbook.Path & "\"
Ext = "*.xlsx"
Application.ScreenUpdating = False
'Reset**** Kannst du rausnehmen
LR1 = TB1.Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile der Spalte
TB1.Rows("2:" & LR1).Delete xlUp
LC = TB1.Cells(1, Columns.Count).End(xlToLeft).Column 'letzte Spalte der Zeile 1
Datei = Dir(Pfad & Ext)
Do While Len(Datei) > 0
Workbooks.Open Filename:=Pfad & Datei
Set TB2 = ActiveSheet
LR1 = TB1.Cells(Rows.Count, 1).End(xlUp).Row
LR2 = TB2.Cells(Rows.Count, 1).End(xlUp).Row
TB2.Range(TB2.Cells(2, LC), TB2.Cells(LR2, LC)) = Left(Datei, InStrRev(Datei, ".") - _
1) 'Dateiname anfügen
TB2.Rows("2:" & LR2).Copy TB1.Rows(LR1 + 1)
Workbooks(Datei).Close SaveChanges:=False
Datei = Dir() ' nächste Datei
Loop
End Sub

Gruß UweD

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Mastertabelle

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

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread