AW: Excel an zwei Orten speichern
12.02.2018 12:04:42
Dennis
Danke Bernd.
Das hat ein wenig geholfen, jedoch funktioniert es nicht wirklich. Mein Problem ist:
Ich nehme eine Datei A, kopiere von Datei A ein paar Tabellenblätter in eine neue Datei B, hier ändere ich noch ein paar Dinge und speichere die neue Datei B an einem speziellen Ort. Dann wird die Datei B (ohne das sie jemals zu sehen war) geschlossen und ich kann wieder wie gewohnt in der Ursprungsdatei A weiterarbeiten.
Hab ich das so geschrieben das man es verstehen konnte?
Hier der Code:
ActiveWorkbook.Save
Worksheets(Array("Januar", "Februar", "März", "April", "Mai", "Juni", "Juli", "August", _
"September", "Oktober", "November", "Dezember")).Copy
ActiveWorkbook.SaveAs Filename:= _
"Speicherort 1" & Format(Now, "YYYY") & Format(Now, "YYYYMMDD_hhmm") & ".xlsx", _
FileFormat:=xlWorkbookDefault, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Call Drucker_Einrichten 'Durckbereich festlegen
Call Saeubern 'alles außerhalb des Druckbereichs löschen
Dim i As Worksheet 'Blattschutz setzen
For Each i In ActiveWorkbook.Worksheets
i.Protect Password:="Test" 'Hier steht das Passwort zum Blattschutz
Next i
Sheets("Dezember").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$AF$54"
Sheets("November").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$AE$56"
Sheets("Oktober").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$AF$56"
Sheets("September").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$AE$59"
Sheets("August").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$AF$56"
Sheets("Juli").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$AF$54"
Sheets("Juni").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$AE$54"
Sheets("Mai").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$AF$54"
Sheets("April").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$AE$54"
Sheets("März").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$AF$56"
Sheets("Februar").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$AD$54"
Sheets("Januar").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$AF$54"
Sheets(Array("Januar", "Februar", "März", "April", "Mai", "Juni", "Juli", "August", _
"September", "Oktober", "November", "Dezember")).Select
'Export an Teamlaufwerk
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"\\Speicherort 1" & Format(Now, "YYYY") & "_Planung" & Format(Now, "YYYYMMDD_hhmm") & _
".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
ActiveWorkbook.Save 'Die neue Arbeitsmappe speichen
ActiveWorkbook.Close
Application.ScreenUpdating = True
'Application.Quit 'Schließt Excel
'Call alle_Dateien_speichern
Application.DisplayAlerts = True
UserForm2.Hide
UserForm1.Show 'UserForm1 Schließen
MsgBox "Diese Version der Planung wurde Erfolgreich sowohl als Excel-Datei " & _
"als auch im PDF-Format auf das Team-Laufwerk gespeichert. " & _
vbNewLine & vbNewLine & _
"Viel Erfolg bei der weiteren Planung.", vbOKOnly, "Meldung der Fertigstellung"