|
Hallo Zusammen,
ich tüftle bereits seit Stunden an einer Lösung zu folgendem Problem. Hoffe ihr könnt mir helfen.
Ich möchte mehrere Tabellenblätter aus verschiedenen Dateien (die alle in einem Ordner stehen) zusammenkopieren in eine neue Datei. Das Makro dazu habe ich schon zusammen und es funktioniert.
Leider funktioniert es allerdings nur so, dass ich jede Datei in dem Ordner anspreche und nicht nur die Dateien die ich eben möchte.
Mein Ziel wäre:
Nur die Dateien öffnen und das entsprechende Tabellenblatt heraus kopieren, dessen Dateiname in einer extra Datei aufgelistet ist.
Hier mein Code bisher:
Sub MWSheetsAusMehrerenDateienEinlesen1()
Dim oTargetBook As Object
Dim oSourceBook As Object
Dim sPfad As String
Dim sDatei As String
Application.ScreenUpdating = False 'Das "Flackern" ausstellen
Application.DisplayAlerts = False 'Keine Fehlermeldungen anzeigen
'Schritt 1: Arbeitsmappe festlegen, in die die neuen Sheets eingefügt werden...
Set oTargetBook = ThisWorkbook
'Wichtiger Hinweis: Die Arbeitsblätter dürfen nicht vorhanden sein!
'Alternativer Umbau: Löschen evtl. bereits vorhandener Arbeitsblätter
'Schritt 2: Schleife über alle Excel Dateien in einem Verzeichnis
sPfad = "C:\DATA\FF-SWE-K\P\Pfister\Test"
sDatei = Dir(CStr(sPfad & "*.xl*")) 'Alle Excel Dateien
Do While sDatei <> ""
'Schritt 3: öffnen der Datei und Datenübertragung
Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True) 'nur lesend öffnen
'Es wird immer das erste Tabellenblatt Sheets(1) kopiert!
oSourceBook.Sheets("VS_Bridge").Copy after:=oTargetBook.Sheets(oTargetBook.Sheets.Count)
'Es wird versucht den Dateinamen als Arbeitsblattnamen zu setzen.
'Ist dieser bereits vorhanden wird der Fehler abgefangen und das neue Blatt
'bekommt keinen anderen Namen und behält den typischen Namen Tabelle x
On Error Resume Next
'Arbeitsblattname wird der Dateiname
oTargetBook.Sheets(oTargetBook.Sheets.Count).Name = sDatei
'Wenn ein Fehler aufgetreten ist, wird dieser resettet
If Err.Number <> 0 Then
Err.Number = 0
Err.Clear
End If
On Error GoTo 0
'Schritt 4: Datei wieder zu machen und nächste Schleifenrunde
oSourceBook.Close False 'nicht speichern
'Nächste Datei
sDatei = Dir()
Loop
Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
Application.DisplayAlerts = True 'Fehlermeldungen wieder anzeigen
'Kleine finale Fertig-Meldung
MsgBox "Fertig!", vbInformation + vbOKOnly, "Hinweis!"
'Variablen aufräumen
Set oTargetBook = Nothing
Set oSourceBook = Nothing
End Sub
Ich vermute, dass ich die Schleife in Schritt 2 einbauen müsste, weiß aber nicht wie das funktioniert.
Meine Tabelle in der alle Dateinamen aufgelistet sind ist wie folgt aufgebaut:
A1: ANA_0002_XYZ.xlsm
A2: ANA_0003_ZKD.xlsm
A3: ANA_0007_SSK.xlsm
usw...
Könnt ihr mir helfen? Danke!
Gruß
Isabell
|