Worksheets aus mehreren Workbooks importieren

Hallo,
ich versuche gerade(mal wieder) ein Makro zu schreiben welches mir aus mehreren XLSM Dateien einzelne Worksheets importiert.
Habe jetzt schon mit zig Codes aus dem Internet experimentiert, aber meine VBA Kenntnisse sind einfach zu schlecht, als dass ich es alleine hinbekommen würde :(
Vielleicht könnt ihr mir helfen?
Also wiegesagt, ich will über Application.FileDialog(msoFileDialogFilePicker) die Workbooks auswählen. Das Makro soll dann in jedem Workbook jeweils das Worksheet mit dem Namen "Analysis" raussuchen und in ein gemeinsames Worksheet mit dem Namen "Comparison" kopieren. Dort sollen die Worksheets dann nach den letzten 5 Buchstaben ihres ursprünglichen Dateinamens bennant werden.
Über meine bisherigen geistigen Ergüsse breite ich lieber einen Mantel des Schweigens ;)
Viele Grüße,
Clemens

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub xlsm_einlesen() sFiles = Application.GetOpenFilename("xlsm-Dateien (*.xlsm),*.xlsm", MultiSelect:=True) If IsArray(sFiles) Then Debug.Print LBound(sFiles), UBound(sFiles) For Each ar In sFiles i = i + 1 Cells(i, 1) = ar Next ar End If End Sub

So, bin schon ein gutes Stück weiter dank Deiner Hilfe!
Super, 1000 Dank! :)
Hier ist der momentane Code, falls es jemand interessiert:

Sub xlsm_einlesen()
Dim WBQ As Workbook, Comparison As Workbook
Dim path As String
sfiles = Application.GetOpenFilename("xlsm-Dateien (*.xlsm),*.xlsm", MultiSelect:=True)
' Workbook "Comparison" anlegen
Workbooks.Add
Set Comparison = ActiveWorkbook
If IsArray(sfiles) Then
Debug.Print LBound(sfiles), UBound(sfiles)
For Each ar In sfiles
i = i + 1
Set WBQ = Workbooks.Open(ar)
'Worksheet mit dem Namen "Analysis" kopieren
WBQ.Sheets("analysis").Copy after:=Comparison.Sheets(i)
'Worksheet umbennenen
Comparison.Sheets("analysis").Name = i 'worksheets durchnummerieren, wird noch geändert
'Pfad zu den ausgewählten Dateien
path = WBQ.path
WBQ.Close
Next ar
'Leere Worksheets im workbook "Comparison" löschen
Application.DisplayAlerts = False
Comparison.Sheets("Sheet1").Delete
Comparison.Sheets("Sheet2").Delete
Comparison.Sheets("Sheet3").Delete
Application.DisplayAlerts = True
' Speichere "Comparison" in dem Ordner,aus dem die Worksheets importiert wurden
Comparison.SaveAs FileName:=path & "\comparison", FileFormat:=xlOpenXMLWorkbookMacroEnabled
End If
End Sub

Beliebteste Forumthreads (12 Monate)

Worksheets aus mehreren Workbooks importieren

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

96 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Worksheets aus mehreren Workbooks importieren

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

96 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread