Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim varRetVal As Variant
Dim strLink As String
Dim strDateiname As String
Dim strVerzeichnis As String
Dim strLaufwerk As String
strVerzeichnis = Range("G90")
strLink = Range("G90")
strVerzeichnis = Left(strVerzeichnis, InStrRev(strVerzeichnis, "\"))
strDateiname = ThisWorkbook.Name
strLaufwerk = Left(strVerzeichnis, 1)
varRetVal = Application.GetSaveAsFilename( _
InitialFileName:=strLink, _
FileFilter:="Microsoft Excel-Dateien (*.xlsm), *.xlsm", _
Title:="Datei speichern unter... ")
If varRetVal = False Then Exit Sub
Cancel = True
Application.EnableEvents = False
ActiveWorkbook.SaveAs varRetVal
Application.EnableEvents = True
End Sub