Sub Backup()
Dim Ordnerpfad As Variant
Dim Pfad As String, Dateiname As String
Dim filepath As String, closefile As String, closefilename As String
Application.ScreenUpdating = False
filepath = ActiveWorkbook.FullName
Pfad = ActiveWorkbook.Path
Datum = Now()
Dateiname = ActiveWorkbook.Name
If InStr(Dateiname, ".") > 0 Then
Dateiname = Left(Dateiname, InStr(Dateiname, ".") - 1)
End If
Datum = Format(Datum, "_dd.mm.yyyy_hh_mm_ss")
closefile = Pfad & "\" & Dateiname & Datum & "_Backup.xlsx"
closefilename = Dateiname & Datum & "_Backup.xlsx"
ActiveWorkbook.Save
ActiveWorkbook.SaveAs Filename:=closefile, FileFormat:=51
Application.Workbooks.Open (filepath)
Workbooks(closefilename).Close SaveChanges:=False
Application.ScreenUpdating = True
End Sub