Hallo Lukas,

wie du schon bemerkt hast, unterscheiden sich die Objektmodelle von Excel und Word in wesentlichen Funktionen. Dass es also kein SaveCopyAs in Word gibt, liegt vielleicht daran, dass es unterschiedliche Programmierer waren, die das erstellt haben. Probier mal diesen Code im Modul ThisDocument. Er sollte nach dem Schließen und neu Öffnen des Documents laufen. Bei Problemen einfach nochmal melden.

Private WithEvents app As Application

Private Sub Document_Open()
  Set app = Application
End Sub

Private Sub app_DocumentBeforeSave(ByVal Doc As Document, SaveAsUI As Boolean, Cancel As Boolean)
  Dim sDatei As String, sPfad As String
  Dim OriginalDatei As String, OriginalPfad As String
  Dim GesPfad As String, fs As Object
  
  
  If Doc Is ThisDocument Then
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    If SaveAsUI = False Then
      OriginalPfad = ActiveDocument.Path & "\"
      OriginalDatei = ActiveDocument.Name
    Else
      With Application.FileDialog(msoFileDialogSaveAs)
        .InitialFileName = ActiveDocument.Name
        .FilterIndex = 2
        If .Show = True Then
          GesPfad = .SelectedItems(1)
          OriginalPfad = Left(GesPfad, InStrRev(GesPfad, "\"))
          OriginalDatei = Right(GesPfad, Len(GesPfad) - Len(OriginalPfad))
        End If
      End With
    End If
   
    sPfad = OriginalPfad & "Archiv\"
    sDatei = Format(Now, "yyyyMMdd_hhmm_") & OriginalDatei
  
    If Not fs.folderexists(sPfad) Then MkDir sPfad
    ActiveDocument.SaveAs2 FileName:=sPfad & sDatei
    ActiveDocument.SaveAs2 FileName:=OriginalPfad & OriginalDatei
  
    Cancel = True
  End If
  
End Sub

Gruß Mr. K.