Nachtrag:

Der zuvor gepostete Code speichert eine Datei nicht ab, wenn ein anderer Dateiname ausgewählt wird, mit diesem Code wird die Speicherung immer ausgeführt:

''' <summary>
''' Speichert aktuelle Arbeitsmappe ab (mit DialogBox "Speichern unter")
''' </summary>
''' <returns>
''' Type: Boolean
''' True = Speichervorgang erfolgreich abgeschlossen
''' False = Speichervorgang nicht durchgeführt
''' </returns>
''' <remarks>
''' Falls der Anwender die Originaldatei überschreiben will, werden folgende Aktionen durchgeführt:
''' - die derzeitige Aktive Arbeitsmappe im %Temp% Verzeichnis speichern
''' - die Originaldatei verschieben in den Unterordner "Sik"
''' - verschieben der im %temp% Verzeichnis gespeicherten Arbeitsmappe in den ursprünglichen Ordner
''' </remarks>
Function FileSaveAs() As Boolean
    Dim varResult As Variant
    
    ' Mit Verweis auf Mirosoft Scripting Runtime
    Dim objFSO As New Scripting.FileSystemObject
    ' Alternativ Late Binding:
    ' ========================
    'Dim objFSO As Object
    'Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    Dim strFilePathOrig As String
    Dim strFilePathSik As String
    Dim strTMPFile As String
    strFilePathSik = ActiveWorkbook.Path & Application.PathSeparator & "sik" & Application.PathSeparator & ActiveWorkbook.Name
    strFilePathOrig = ActiveWorkbook.Path & Application.PathSeparator & ActiveWorkbook.Name
    varResult = Application.GetSaveAsFilename(InitialFileName:=strFilePathOrig, FileFilter:= _
        "Excel Arbeitsmappe (*.xlsx), *.xlsx, Excel Arbeitsmappe mit Makros (*.xlsm), *.xlsm", _
        FilterIndex:=IIf(ActiveWorkbook.HasVBProject, 2, 1))
    If Not varResult = False Then
        If LCase(varResult) = LCase(strFilePathOrig) Then
            ' Die aktuelle Datei als temporäre Datei speichern
            
            strTMPFile = Environ("TEMP") & "\Temp.xls" & IIf(ActiveWorkbook.HasVBProject, "m", "x")
            If objFSO.FileExists(strTMPFile) Then
                Kill strTMPFile
            End If
            ActiveWorkbook.SaveAs strTMPFile
            ActiveWorkbook.Close
            ' Original verschieben
            If Not objFSO.FolderExists(objFSO.GetParentFolderName(strFilePathSik)) Then
                MkDir objFSO.GetParentFolderName(strFilePathSik)
            End If
            If objFSO.FileExists(strFilePathSik) Then
                Kill strFilePathSik
            End If
            objFSO.MoveFile strFilePathOrig, strFilePathSik
            
            ' Verschieben der Temporären Datei zur Original-Datei
            objFSO.MoveFile strTMPFile, strFilePathOrig
            Application.Workbooks.Open strFilePathOrig
            FileSaveAs = True
        Else
            ActiveWorkbook.SaveAs varResult
            FileSaveAs = True
        End If
    End If
End Function

Falls bereits eine Sicherungskopie von einem vorhergehenden Speicher-Vorgang angelegt wurde, wird diese ungefragt überschrieben!

Falls dies nicht sein soll, muss folgender Code verwendet werden:

''' <summary>
''' Speichert aktuelle Arbeitsmappe ab (mit DialogBox "Speichern unter")
''' </summary>
''' <returns>
''' Type: Boolean
''' True = Speichervorgang erfolgreich abgeschlossen
''' False = Speichervorgang nicht durchgeführt
''' </returns>
''' <remarks>
''' Falls der Anwender die Originaldatei überschreiben will, werden folgende Aktionen durchgeführt:
''' - die derzeitige Aktive Arbeitsmappe im %Temp% Verzeichnis speichern
''' - die Originaldatei verschieben in den Unterordner "Sik"
''' - verschieben der im %temp% Verzeichnis gespeicherten Arbeitsmappe in den ursprünglichen Ordner
'''
''' Falls eine Sicherungskopie bereits vorhanden ist, wird diese nicht überschrieben!
''' </remarks>
Function FileSaveAs() As Boolean
    Dim varResult As Variant
    
    ' Mit Verweis auf Mirosoft Scripting Runtime
    Dim objFSO As New Scripting.FileSystemObject
    ' Alternativ Late Binding:
    ' ========================
    'Dim objFSO As Object
    'Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    Dim strFilePathOrig As String
    Dim strFilePathSik As String
    Dim strTMPFile As String
    strFilePathSik = ActiveWorkbook.Path & Application.PathSeparator & "sik" & Application.PathSeparator & ActiveWorkbook.Name
    strFilePathOrig = ActiveWorkbook.Path & Application.PathSeparator & ActiveWorkbook.Name
    varResult = Application.GetSaveAsFilename(InitialFileName:=strFilePathOrig, FileFilter:= _
        "Excel Arbeitsmappe (*.xlsx), *.xlsx, Excel Arbeitsmappe mit Makros (*.xlsm), *.xlsm", _
        FilterIndex:=IIf(ActiveWorkbook.HasVBProject, 2, 1))
    If Not varResult = False Then
        If LCase(varResult) = LCase(strFilePathOrig) Then
            ' Prüfen, ob noch keine Sicherungskopie existiert
            If Not objFSO.FileExists(strFilePathSik) Then
                
                ' Die aktuelle Datei als temporäre Datei speichern
                
                strTMPFile = Environ("TEMP") & "\Temp.xls" & IIf(ActiveWorkbook.HasVBProject, "m", "x")
                If objFSO.FileExists(strTMPFile) Then
                    Kill strTMPFile
                End If
                ActiveWorkbook.SaveAs strTMPFile
                ActiveWorkbook.Close
                ' Original verschieben
                If Not objFSO.FolderExists(objFSO.GetParentFolderName(strFilePathSik)) Then
                    MkDir objFSO.GetParentFolderName(strFilePathSik)
                End If
                If objFSO.FileExists(strFilePathSik) Then
                    Kill strFilePathSik
                End If
                objFSO.MoveFile strFilePathOrig, strFilePathSik
                
                ' Verschieben der Temporären Datei zur Original-Datei
                objFSO.MoveFile strTMPFile, strFilePathOrig
                Application.Workbooks.Open strFilePathOrig
                FileSaveAs = True
            Else
                ActiveWorkbook.Save
                FileSaveAs = True
            End If
        Else
            ActiveWorkbook.SaveAs varResult
            FileSaveAs = True
        End If
    End If
End Function

VG, BigBen