Sub СОХРАНИТЬ_КОПИЮ_ДОМ()

Da = MsgBox("Создать файл?", vbYesNo, "")
If Da = vbYes Then

   On Error Resume Next
    
    ' название подпапки, в которую по-умолчанию будет предложено сохранить файл
    Const REPORTS_FOLDER = "ГРАФИК ОПЕРАТОРОВ\"
    ' создаём папку для файла, если её ещё нет
    MkDir ThisWorkbook.Path & "\" & REPORTS_FOLDER
    ' выбираем стартовую папку
    ChDrive Left(ThisWorkbook.Path, 1): ChDir ThisWorkbook.Path & "\" & REPORTS_FOLDER
    
    ' вывод диалогового окна для запроса имени сохраняемого файла

    ' если пользователь отказался от выбора имени файла - отменяем сохранение листа в файл
    If VarType(Filename) = vbBoolean Then Exit Sub
    ' добавляем расширение
    Filename = "ГРАФИК ОПЕРАТОРОВ " & Worksheets(1).Range("M7").Value & "xls." & "xls"
    
    ' копируем активный лист (при этом создаётся новая книга)
    Err.Clear: Worksheets(7).Copy: DoEvents
    If Err Then Exit Sub    ' произошла какая-то ошибка при попытке копирования листа
    
    ' убеждаемся, что активной книгой является копия листа
    If ActiveWorkbook.Worksheets.Count = 1 And ActiveWorkbook.Path = "" Then
        ' сохраняем файл под заданным именем в формате Excel 2003
        ActiveWorkbook.SaveAs Filename, xlWorkbookNormal
        
        ' закрываем сохранённый файл
        ' (удалите следующую строку, если закрывать созданный файл не требуется)
        ActiveWorkbook.Close False
    End If
   Worksheets(7).Protect Password:="1"
    End If

End Sub