Hallo,
da ich mit VBA nicht so viel Ahnung habe und aktuell nicht weiter komme frage ich hier um Rat :)
Über
google findet mal viele Lösungen, aber leider nichts, was wirklich läuft, da vieles file.system.object verwendet, was ja in neueren Versionen nicht mehr funktioniert.
Ich möchte via Excel Makro mehrere .xlsx Dateien aus einem Ordner in einer Datei zusammenführen, und zwar so, dass jede Datei eine einzelne Mappe wird.
Beispiel: In einem Ordner liegen die Dateien 001_100.xlsx, 001_150.xlsx, usw. wobei alle Excel Dateien aus dem Ordner verwendet werden sollen.
Am Ende benötige ich ein Excel Sheet, dass eine Mappe 001_100 mit den Daten aus 001_100.xlsx enthält usw.
Funktionsfähig gefunden habe ich z.B. folgenden Code
Option Explicit
Const ImportDatei = "Test.xlsx"
Const StartOrdner = "C:\Sheets\*"
Sub SheetsImport()
Dim Dlg As FileDialog, Wks As Worksheet, i As Integer
Set Wks = Workbooks(ImportDatei).Sheets(1): Wks.Cells.Clear
Set Dlg = Application.FileDialog(msoFileDialogOpen)
Dlg.InitialFileName = StartOrdner
Dlg.Filters.Add "Excel Dateien", "*.xlsx", 1
DlgNext:
If Dlg.Show = False Then Exit Sub
For i = 1 To Dlg.SelectedItems.Count
Call SheetsInsert(Wks, Dlg.SelectedItems(i))
Next
GoTo DlgNext
End Sub
Private Sub SheetsInsert(ByRef Wks, ByRef Path)
Dim xWkb As Workbook, xWks As Worksheet, NextLine As Integer
Application.ScreenUpdating = False
Set xWkb = Workbooks.Open(Path): Set xWks = xWkb.Sheets(1)
NextLine = Wks.Cells(Wks.Rows.Count, "A").End(xlUp).Row
If NextLine > 1 Then NextLine = NextLine + 1
xWks.Rows("3:" & xWks.Cells(xWks.Rows.Count, "A").End(xlUp).Row).Copy
Wks.Rows(NextLine).Insert Shift:=xlDown
Application.CutCopyMode = False: xWkb.Saved = True: xWkb.Close
Application.ScreenUpdating = True
End Sub
Das Problem hierbei ist, dass die Daten untereinander in eine Mappe geschrieben werden und nicht separat.
Vielen Dank für eine Rückmeldung :)
