aktualisieren ohne alles nochmal einzufügen
25.09.2019 11:09:57
Bene
Ich habe ein Problem und benötige dringend Hilfe.
Ich habe in einem Ordner (KW-KÖLN) viele Excel Dateien und kopiere jede Datei und füge sie als Tabelle in eine andere Excel-Datei Zusammenfassung ein.
Also statt 10 Excel Dateien habe ich eine Excel Datei Zusammenfassung mit 10 Tabellen.
Mein Ordner (KW-KÖLN) wird aber stündlich mit einer neuen Excel Datei erweitert. Mit dem Code ist es nicht möglich die Excel-Datei (Zusammenfassung) zu aktualisieren.
Denn mit dem Code werden nochmal alle Dateien als Tabelle eingefügt.
Das heißt: In dem Ordner habe ich nach einer Stunde 11 Dateien und in meine Excel-Datei (Zusammenfassung) statt 11 Tabellen 21 Tabellen, da die vorherigen 10 Excel Dateien nochmal kopiert und als Tabelle eingefügt werden.
Mein Ziel ist es, dass zunächst einmal alle Dateien aus KW-KÖLN kopiert und als Tabelle eingefügt werden und später nur die neu hinzugekommenen .
Sub HI()
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 = ActiveWorkbook
'Schritt 2: Schleife über alle Excel Dateien in einem Verzeichnis
sPfad = "C:\Users\PNL\Desktop\BENE\"
sDatei = Dir(CStr(sPfad & "*.csv*")) '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)
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 bin euch für eure Hilfe sehr Dankbar.
Viele Grüße,
Bene