Habe es doch noch hinbekommen, man sollte halt nicht mit leeren Tabellenblättern testen ;-)
Hier der gesamte Code falls ihn jemand brauchen kann:
Ein grosses Dankeschön an xlKing und ralf_b!!!
Sub TabellenAlsDateienSpeichern()
Dim strPfad As String
'Pfad ist jedes Jahr neu anzupassen
Const JAHR = "MeinPfad\Testordner Makros\2022\"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
strPfad = JAHR
If Dir(strPfad, vbDirectory) = "" Then
MkDir strPfad
End If
' mehrere Tabellenblätter speichern:
' ThisWorkbook.Worksheets(Array("Test1", "Test2")).copy
' nur ein Tabellenblatt speichern:
ThisWorkbook.Worksheets("Test1").copy
' als Excel Datei speichern:
' ActiveWorkbook.SaveAs (strPfad & Environ("Username") & "_" & Format(Now, "DD_MM_YYYY_hh_mm_ss")) & ".xlsx"
' als PDF Dtei speichern:
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=(strPfad & Environ("Username") & "_" & Format(Now, "DD_MM_YYYY_hh_mm_ss"))
ActiveWorkbook.Close savechanges:=False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
|