Mit Makro mehrere Dateien aktualisieren
13.11.2018 16:09:25
jinu
Ich habe eine Datei "Test-Master" (Pfad: C:\Test) in der das unten stehende Makro enthalten ist. Mit dem Makro sollen folgende Schritte ausgeführt werden:
1. Das erste Tabellenblatt "Eingabe" soll berechnet werden.
2. Alle anderen Tabellenblätter sollen neu berechnet werden
3. Alle Tabellenblätter werden durchsucht und Zellen mit der Formel "DBRW" werden kopiert und als Werte eingefügt.
4. Speicherung der aktualisierten Datei in einem neuen Ordner entsprechend dem ausgewählten Monat ( C:\Test\Ziel\2018-eingestellter Monat )
Option Explicit
Sub Berechnen_DestroyDBRW_Speichern()
Dim strPath As String
Dim strFileName As String, strSpeichermonat As String
Dim rngCell, rngCell2 As Range
Dim WS_Count As Integer
Dim I As Integer
Application.ScreenUpdating = False
strPath = "C:\Test\Ziel" 'Pfad anpassen
If Right(strPath, 1) "\" Then strPath = strPath & "\"
With Sheets("Eingabe")
.Calculate
strSpeichermonat = "2018-" & Format(DateSerial(Year(.Range("N3")), Month(.Range("N3")), Day(. _
Range("N3"))), "MMMM") & "\"
strFileName = strPath & strSpeichermonat & "2018-" & Format(DateSerial(Year(.Range("N3")), _
Month(.Range("N3")), Day(.Range("N3"))), "MMMM") & "_" & UCase(.Range("R3")) & ".xlsm"
End With
On Error GoTo ErrorHandler
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 1 To WS_Count
Sheets(I).Calculate
Sheets(I).Select
Application.ScreenUpdating = False
Set rngCell = Cells.Find(What:="DBRW", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
While Not rngCell Is Nothing
rngCell.Value = rngCell.Value
Set rngCell = Cells.FindNext(After:=rngCell)
Wend
Application.CutCopyMode = False
Range("A1").Select
Application.ScreenUpdating = True
Next I
'Prüfen ob Ordner mit Monatsnamen vorhanden
'wenn nein, dann anlegen
If Dir(strPath & strSpeichermonat, vbDirectory) = "" Then
MkDir (strPath & strSpeichermonat)
End If
ThisWorkbook.SaveAs Filename:=strFileName, FileFormat:=52
MsgBox "Kein DBRW mehr gefunden"
ErrorHandler:
Application.ScreenUpdating = True
End Sub
Das funktioniert auch soweit mit dem Makro, auch wenn es vielleicht eine einfachere oder elegantere Lösung dafür gegeben hätte.
Ich habe jedoch in dem Ordner (C:\Test) noch 3 Weitere Dateien (Test2, Test3, Test4), die gleich aufgebaut sind, die ich in das Makro aus der Master-Datei integrieren möchte, dass die jeweiligen Dateien geöffnet werden, dann das Tabellenblatt "Eingabe" berechnet wird, anschließend die restlichen Tabellenblätter, dann überall "DBRW" entfernen und Werte dort einsetzen und zum Schluss die Datei unter dem selben Ordner wie zuvor abspeichern.
Es sollen mit dem Makro aus der Master-Datei alle 4 Dateien aktualisiert und in dem richtigen Ordner gespeichert werden.Kann man vielleicht eine Schleife einbauen, dass auf alle 3 zusätzlichen Dateien zugegriffen wird?
Habt ihr eine Idee wie ich es umsetzten kann?
Vielen Dank und viele Grüße
Jinu
Beispieldateien
https://www.herber.de/bbs/user/125360.zip