Sub Save()
Dim fs As New FileSystemObject
MC = "C:\MMA_Real\Дополнения\Копия\" & Year(Now)
If Not fs.FolderExists(MC) Then
            fll = fs.CreateFolder(MC)
        Else
End If
MC = "C:\MMA_Real\Дополнения\Копия\" & Year(Now) & "\" & Month(Now)
If Not fs.FolderExists(MC) Then
            fll = fs.CreateFolder(MC)
        Else
End If
MC = "C:\MMA_Real\Дополнения\Копия\" & Year(Now) & "\" & Month(Now) & "\" & Day(Now)
If Not fs.FolderExists(MC) Then
            fll = fs.CreateFolder(MC)
        Else
        fll = MC
End If
ThisWorkbook.Save
Dim sFileName As String, sNewFileName As String

    sFileName = "C:\MMA_Real\Дополнения\Начало.xlsm"  'имя файла для копирования
    sNewFileName = fll & "\Начало.xlsm" 'имя копируемого файла. Директория(в данном случае диск D) должна существовать
    'If Dir(sFileName, 16) = "" Then MsgBox "Нет такого файла", vbCritical, "Ошибка": Exit Sub
    
    FileCopy sFileName, sNewFileName 'копируем файл

End Sub