Tabellenblätter in Masterdatei zusammen
13.10.2021 12:31:19
Jane
ich habe im Internet folgenden VBA Code gefunden (weiter unten zu sehen). Ich möchte nun aber gern keinen Pfad im Code angeben sondern möchte Dateien im Verzeichnis auswählen, über den Befehl Application.GetOpenFilename(FileFilter:="Microsoft Excel-Dateien (*.xl*), *.xl*", Title:="Datei(en) auswählen", MultiSelect:=True)
Da meine VBA Kentnisse nicht so gut sind, bekomme ich es leider absolut nicht hin diese beiden Codes miteinander zu verknüpfen.
Ich hoffe mir kann jemand helfen. Sollte so ein ähnliches Anliegen schon in einem anderen Post erklärt sein, bitte ich das zu entschuldigen, denn ich habe leider nichts dazu gefunden.
Public Sub MergeAggregate()
Const FOLDER_PATH = "C:\Ordner\" 'Pfad angepasst
Dim strFilename As String
Dim objTargetWorksheet As Worksheet
Dim objSourceWorkbook As Workbook
Application.ScreenUpdating = False
'Active Tabelle
Set objTargetWorksheet = ActiveSheet
'erste Datei suchen
strFilename = Dir$(FOLDER_PATH & "*.xlsx")
Do Until strFilename = vbNullString
'Öffnet eine Datei
Set objSourceWorkbook = Workbooks.Open(Filename:=FOLDER_PATH & strFilename)
'Kopiert von den Zeilen 2 bis zum Ende
With objSourceWorkbook.ActiveSheet
.Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 6)).Copy
End With
'in die aktive Mappe und fügt sie jeweils unten an
With objTargetWorksheet
.Paste Destination:=.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
End With
'Schliesst die geöffnete Datei
Call objSourceWorkbook.Close(SaveChanges:=False)
'lese den nächsten Dateinamen
strFilename = Dir$()
Set objSourceWorkbook = Nothing
Loop
Set objTargetWorksheet = Nothing
Application.ScreenUpdating = True
End Sub
VG Jane