Automatische Aktualisierung in Dateien

Option Explicit
' Original-Quelltext unter: https://www.online-vba.de/automatische-aktualisierung-in-dateien
' Express-Hilfe für VBA unter https://www.online-vba.de/vba-expresshilfe
' Es gelten die Nutzungsbedingungen von Online-VBA.de

' ACHTUNG: ALLE DATEIEN IN DEM ANGEGEBENEN PFAD WERDEN UNWIDERRUFLICH GEÄNDERT!
' DENKEN SIE IMMER AN EINE AUSREICHENDE DATENSICHERUNG!!!

Public Sub OVBAde_MultiDateiUpdate()
  Dim oSourceBook As Object
  Dim sPfad As String
  Dim sDatei As String
    
    Application.ScreenUpdating = False 'Das "Flackern" ausstellen
    
    'Schritt 1: Schleife über alle Excel Dateien in einem Verzeichnis
    sPfad = "C:\TEST\Sammlung\"
    sDatei = Dir(CStr(sPfad & "*.xl*")) 'Alle Excel Dateien
    
    Do While sDatei <> ""
    
        'Schritt 2: Öffnen der Datei und Datenübertragung
        Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, False) 'nur lesend öffnen
        
        'Änderungen durchführen, als Beispiel Zelle A1 mit "Hallo" befüllen
        oSourceBook.Sheets("Tabelle1").Cells(1, 1).Value = "Hallo"
        
        'Schritt 3: Datei speichern und wieder zu machen und nächste Schleifenrunde
        Application.DisplayAlerts = False
        oSourceBook.Close True 'speichern
        Application.DisplayAlerts = True
        
        'Nächste Datei
        sDatei = Dir()
    Loop
    
    Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
    
    'Variablen aufräumen
    Set oSourceBook = Nothing
End Sub