|
Guten Tag Zusammen,
ich habe letztens eine Anforderung bekommen, mittels einem Makro zwei unterschiedliche Excel Dateien an zwei Orten zu speichern.
Wenn ich ein Programmablaufplan formuliere würde der so aussehen:
1. Wenn Excel Datei 1 geöffnet ist, Excel Datei 1 in Speicherort A und Speicherort B speichern
2. Wenn Excel Datei 2 geöffnet ist, Excel Datei 2 in Speicherort A und Speicherort B speichern
Mein Gedanke war: Ok einfach, ich brauche eine Dateiprüfung am Anfang und anhand des Dateinamens sollte das Makro das entsprechend speichern.
Ich habe versucht das Umzusetzen bin aber ab meinen bescheidenen Programmierfähigkeiten gescheitert. Ich habe etwas hinbekommen das auch funktioniert, nur nicht ganz so wie ich das möchte.
Wenn ich das Makro in Excel Datei 1 ausführe, speichert sich das korrekt, alles ok!
Wenn ich das Makro in Excel Datei 2 ausführe,speichert sich das korrekt aber Excel Datei 1 wird noch zusätzlich geöffnet.
Wenn jemand sich mein Stückchen Code ankucken könnte wäre ich sehr dankbar :)
Sub Speichern()
Dim Dateiname As String
Dateiname = ActiveWorkbook.Name
Application.DisplayAlerts = False
If Dateiname = "Excel Datei 1" Then
ActiveWorkbook.SaveAs Filename:="Speicherort 1" & Dateiname & " ", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.SaveAs Filename:="Speicherort 2" & Dateiname & " ", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Workbooks("Excel Datei 1").Close SaveChanges:=False
End If
If Dateiname = "Excel Datei 2" Then
ActiveWorkbook.SaveAs Filename:="Speicherort 1" & Dateiname & " ", _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.SaveAs Filename:="Speicherort 2" & Dateiname & " ", _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Workbooks("Excel Datei 2").Close SaveChanges:=False
End If
Application.DisplayAlerts = True
End Sub
|