VBA: Nach automatischen Speichern Makros löschen

Sub Speichern_unter()
Dim Datei As String
Dim Verzeichnis As String
Dim SaveDummy As Variant
Dim strName As String
If Sheets("Hochkant").Range("H5").Value = "" Then
MsgBox "Bitte Teilenummer eingegeben!"
ElseIf Sheets("Hochkant").Range("AQ6").Value = "" Then
MsgBox "Bitte mindestens ein Stichwort eingeben! (Stichwortfeld Nr.1)"
Else
Verzeichnis = "K:\Benutzer\Ordner\" 'Verzeichnis-Vorschlag
Datei = Left(Range("H5"), 5) & "_" & Mid(Range("H5"), 6, 4) & "_" & Right(Range("H5"), 1) & " _
_Inspectionreport_" & Range("X5") & ActiveSheet.Range("AQ6").Value & ".xls" 'Datei-Vorschlag
SaveDummy = SpeichernUnter(Verzeichnis & Datei)
If SaveDummy  False Then ActiveWorkbook.SaveAs SaveDummy 'Es wurde im Dialog auf Speichern  _
gedrückt
Application.Workbooks(Datei).Close True
End If
End Sub

Function SpeichernUnter(VorgabeName As String) As Variant
SpeichernUnter = Application.GetSaveAsFilename(InitialFileName:=VorgabeName, Filefilter:="Excel  _
Dateien (*.xls),*.xls*", _
FilterIndex:=1, Title:="Speichern unter...", ButtonText:="speichern")
End Function