Sub Drucken_und_Kopie()
Dim Ordnerpfad As Variant
Dim Pfad As String, Dateiname As String
Dim filepath As String, Schliessen As String, Zuschliessend As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
filepath = ActiveWorkbook.FullName
Pfad = ActiveWorkbook.Path
Dateiname = ActiveWorkbook.Name
If InStr(Dateiname, ".") > 0 Then
Dateiname = Left(Dateiname, InStr(Dateiname, ".") - 1)
End If
Schliessen = Pfad & "_Kopie.xlsx"
Zuschliessend = Dateiname & "_Backup.xlsx"
ActiveWorkbook.Save
ActiveWorkbook.SaveAs FileName:=Schliessen, FileFormat:=51
Application.Workbooks.Open (filepath)
Workbooks(Zuschliessend).Close SaveChanges:=False
ActiveWorkbook.PrintOut Copies:=1, Collate:=True, Preview:=False, ActivePrinter:="Dein Druckernamen"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub