Erstmals, die letzte Nachricht leserlich
Dank der korrigierten Codes funktioniert das Makro.
Und ja, es war am Anfang nicht die Rede davon die Exceldateien nach dem Kopieren in einem Archivordner zu speichern.
Das war meine eigene Problemlösung dafür die Dauerschleife außer Kraft zu setzen.
Jetzt wird der Inhalt der XLS Dateien, wie im Code geschrieben, korrekterweise in verschiedene Tabellenblätter geschrieben. Wie muss der Code angepasst werden, damit die Inhalte in ein Tabellenblatt untereinander geschrieben werden?
Und, um den letzten Schritt vorweg zunehmen, soll die generierte XLS Datei zum Schluss noch als CSV File gespeichert werden.
ist halt learning by doing und step by step ist das einfacher nachzuvollziehen ;-)
Sub Zusammenführen()
Dim oTargetBook As Object
Dim oSourceBook As Object
Dim sPfad As String
Dim sDatei As String
Dim wkbMappe As Workbook
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 wkbMappe = Workbooks.Add
Set oTargetBook = ActiveWorkbook
'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 = "Z:\dep_Controlling-WSA\07 Monatsabschluss\ILV-Makros\Stundenerfassung\Einzelbelege\"
sDatei = Dir(CStr(sPfad & "*.xlsx*")) '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(1).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 Fahler aufgetreten ist, wird dieser resettet
If Err.Number <> 0 Then
Err.Numer = 0
Err.Clear
End If
On Error GoTo 0
'Schritt 4: Datei wieder zu machen und nächste Schleifenrunde
oSourceBook.Close False 'nicht speichern
sDatei = Dir
Loop
End Sub
|