Excel dateien automatisch zusammenführen

Hallo zusammen
Ich möchte aus sämtlichen Ordner einer Verzeichnisstruktur die Daten aus den jeweiligen Excel Dateien auslesen und in ein Master kopieren. Die Master Datei ist in der obersten Hirachie Stufe, mehrere Dateien dann je Ordner sind unterhalb des Masterfiles.

Master.xls 

--> Ordner "Dat1" mit den Dateien "Dat1_01.xls" und "Dat1_02.xls"

--> Ordner "Dat2" mit den Dateien "Dat2_01.xls" und "Dat2_02.xls"

usw...

Im Forum hier habe ich ein Beispiel gefunden und ein wenig angepasst. Im Master.xls ist ein Button mit dem "File open" aufgerufen wird, von dort aus wird die Datei angewählt und an die nächste freie Zelle kopiert. #
Das funktioniert auch soweit.
Nun ist meine Frage, da es ziemlich viele Dateien sind, kann man das manuelle file auswählen irgendwie automatisieren? Ich möchte einfach auf den Imort Button im Master klicken, dass wird automatisch in den ersten Ordner gesprungen, die Datei geöffnet, Inhalte in den Master kopiert, zur nächsten Datei gewechselt. Ist die letzte Datei ferig kopiert wird in den nächsten Ordner gesprungen usw. usw.
Habe noch ein zip mit der Struktur und den Dateien in der File-Upload gelegt...
https://www.herber.de/bbs/user/64714.zip
Hat da jemand ne Idee?
Danke und Gruss skaddy

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Benutzer

Hallo Skaddy,
hier eine angepasste Version deines Import-Makros.
Gruß
Franz

Sub DateiImportieren()
Dim strFile As String
Dim lRow As Long, lastRow As Long
Dim wks As Worksheet, quelle As Worksheet, wkb As Workbook
Dim PfadBasis As String, arrVerz() As String, intI As Long
On Error GoTo ERRORHANDLER
PfadBasis = ThisWorkbook.Path
'Dateien Unterverzeichnisse im Verzeichnis der Datei in Array einlesen
strFile = Dir(PfadBasis & Application.PathSeparator & "*.*", vbDirectory)
Do Until strFile = ""
intI = intI + 1
ReDim Preserve arrVerz(1 To intI)
arrVerz(intI) = PfadBasis & Application.PathSeparator & strFile
strFile = Dir
Loop
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
Set wks = ActiveSheet 'Zielblatt
For intI = 1 To UBound(arrVerz)
If Not (Dir(arrVerz(intI), vbDirectory) = "" _
Or arrVerz(intI) = PfadBasis & Application.PathSeparator & "." _
Or arrVerz(intI) = PfadBasis & Application.PathSeparator & "..") Then
strFile = Dir(arrVerz(intI) & Application.PathSeparator & "*.xl*", vbNormal)
Do Until strFile = ""
strFile = arrVerz(intI) & Application.PathSeparator & strFile
Set wkb = Workbooks.Open(strFile)
Set quelle = wkb.Sheets(1)
'letzte Zelle suchen...
lastRow = quelle.Cells(Rows.Count, 1).End(xlUp).Row
'Letzte Reihe im zu kopierenden Sheet ist kleiner als..
If lastRow

Beliebteste Forumthreads (12 Monate)

Excel dateien automatisch zusammenführen

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Excel dateien automatisch zusammenführen

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread