Werte in mehrere geschlossene Dateien schreiben

Hallo,
ich weiß das dieses Thema hier schon oft besprochen wurde, allerdings bin ich mit der Recherche usw. nicht weiter gekommen!
Das Problem ist wie folgt:
Ich habe ca. 2400 Exceldateien die absolut identisch aufgebaut sind und im gleichen Ordner liegen.
In all diesen Dateien sollen in 2 bestimmten Feldern der gleiche Wert geschrieben werden.
Das manuell zu machen dauert ewig und länger..
Am liebsten hätte ich eine "Master Excelmappe" die den Makrozugriff steuert.
Ich müsste nämlich nach den 2400 Dateien weitere paar Tausend Dokumente auf die selbe Art editieren, nur andere Werte (aber in die gleichen Felder schreiben)
Von daher wäre es am besten wenn der Code sich leicht auf das neue Szenario anpassen lässt..
Kann mir jemand sagen wie das geht oder mir genaue Links zur Umsetzung geben?
Vielen vielen Dank!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub alle_Dateien_Verzeichnis() ' Dim strFile$, strPath$, strExt$, TB$, Zelle1$, Zelle2$, Zelle3$, NWert1$, NWert2$, NWert3$ strPath = "C:\Test\" 'Pfad des Verzeichnisses ggf. anpassen strExt = "*.xls" 'Dateiextension ggf. anpassen TB = "Summary" ' der Name des Tabellenblattes Zelle1 = "D6" 'Beispielzelle 1 Zelle2 = "D7" 'Beispielzelle 2 Zelle3 = "D19" 'Beispielzelle 2 NWert1 = "Service" 'der Neue Wert1 NWert2 = "Tower" 'der Neue Wert2 NWert3 = "Country" 'der Neue Wert2 If strPath = "" Then Exit Sub Else strFile = Dir(strPath & strExt) On Error GoTo fehler Do While Len(strFile) > 0 Workbooks.Open Filename:=strPath & strFile Sheets(TB).Range(Zelle1).Value = NWert1 Sheets(TB).Range(Zelle2).Value = NWert2 Sheets(TB).Range(Zelle3).Value = NWert3 Application.DisplayAlerts = False Workbooks(strFile).Close savechanges:=True Application.DisplayAlerts = True strFile = Dir() ' nächste Datei Loop End If Exit Sub fehler: If Err.Number = 9 Then MsgBox "Blatt: " & TB & " ist in " & strFile & " nicht vorhanden" Err.Clear Resume Next Else MsgBox "unbekannter Fehler in " & strFile Err.Clear Resume Next End If End Sub

so gehts, Hab ein bestehendes Makro angepasst.


Sub alle_Dateien_Verzeichnis() '
Dim strFile$, strPath$, strExt$, TB$, Zelle1$, Zelle2$, NWert1$, NWert2$
strPath = "C:\Test\" 'Pfad des Verzeichnisses ggf. anpassen
strExt = "*.xls"       'Dateiextension ggf. anpassen
TB = "Tabelle1" ' der Name des Tabellenblattes
Zelle1 = "A4" 'Beispielzelle 1
Zelle2 = "B4" 'Beispielzelle 2
NWert1 = "1000" 'der Neue Wert1
NWert2 = "=A1/A4" 'der Neue Wert2
If strPath = "" Then
Exit Sub
Else
strFile = Dir(strPath & strExt)
On Error GoTo fehler
Do While Len(strFile) > 0
Workbooks.Open Filename:=strPath & strFile
Sheets(TB).Range(Zelle1).Formula = NWert1
Sheets(TB).Range(Zelle2).Formula = NWert2
Application.DisplayAlerts = False
Workbooks(strFile).Close savechanges:=True
Application.DisplayAlerts = True
strFile = Dir() ' nächste Datei
Loop
End If
Exit Sub
fehler:
If Err.Number = 9 Then
MsgBox "Blatt: " & TB & " ist in " & strFile & " nicht vorhanden"
Err.Clear
Resume Next
Else
MsgBox "unbekannter Fehler in " & strFile
Err.Clear
Resume Next
End If
End Sub

Dateien aus dem angegebenen Verzeichnis werden alle abgearbeitet.
Tabellenblattname, Zellen, und Zelleninhalt anpassen.
Es wird immer als Formel zurückgeschrieben. Wenn nur ein Wert rein soll ist das aber egal. (Dann ist die Formel eben konstant)
Gruß UweD

Beliebteste Forumthreads (12 Monate)

Werte in mehrere geschlossene Dateien schreiben

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Werte in mehrere geschlossene Dateien schreiben

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread