Sub СохранитьЛистВФайлИмяЯчейкиДатаСменаPL_GA()
     On Error Resume Next
    ' путь к папке, в которую по-умолчанию будет предложено сохранить файл
    folder$ = "C:\PetroKarton\I_PL_GA\": MkDir folder$
    ChDrive Left(folder$, 1): ChDir folder$ ' выбираем стартовую папку

    ' формируем имя файла из текста ячеек
    Filename = [A1] & ".xlsx"
 
    ' копируем активный лист (при этом создаётся новая книга)
    Err.Clear: ActiveSheet.Copy: DoEvents
    If Err Then Exit Sub    ' произошла какая-то ошибка при попытке копирования листа

    ' убеждаемся, что активной книгой является копия листа
    If ActiveWorkbook.Worksheets.Count = 1 And ActiveWorkbook.Path = "" Then
        ' сохраняем файл под заданным именем в формате XLSX (xlOpenXMLWorkbook - Excel 2007)
         With ActiveSheet.UsedRange
        .Value = .Value
         End With
         ActiveSheet.DrawingObjects.Delete
        
        ActiveWorkbook.SaveAs Filename, xlOpenXMLWorkbook
        ' закрываем сохранённый файл
        ActiveWorkbook.Close False
    End If
    MsgBox "План/Смена/Дата_сохранён!"
End Sub

Sub СохранитьЛистВФайлИмяЯчейки()
    On Error Resume Next
    ' название подпапки, в которую будет сохранён файл
    Const REPORTS_FOLDER = "Отчёты\"
    MkDir ThisWorkbook.path & "\" & REPORTS_FOLDER    ' создаём папку для файла, если её ещё нет

    ' формируем имя файла из текста ячеек
     Filename = [b1] & ".xlsx"
    ' копируем активный лист (при этом создаётся новая книга)
    Err.Clear: ActiveSheet.Copy: DoEvents
    If Err Then Exit Sub    ' произошла какая-то ошибка при попытке копирования листа

    ' убеждаемся, что активной книгой является копия листа
    If ActiveWorkbook.Worksheets.Count = 1 And ActiveWorkbook.path = "" Then
        ' сохраняем файл под заданным именем в формате XLSX (xlOpenXMLWorkbook - Excel 2007)
        ActiveWorkbook.SaveAs Filename, xlOpenXMLWorkbook
        ' закрываем сохранённый файл
        ActiveWorkbook.Close False
    End If
End Sub

Sub DirCopy()
    Dim OldPath$, NewPath$, Shablon$, OnlyName$
    OldPath = "C:\Users\Aswerd_nout\Desktop\1"
    NewPath = "C:\Users\Aswerd_nout\Desktop\2"
    Shablon = "*.*"
    OnlyName = Dir(OldPath & Shablon, vbReadOnly + vbHidden + vbSystem)
    Do Until OnlyName = ""
        FileCopy OldPath & OnlyName, NewPath & OnlyName
        OnlyName = Dir
    Loop
End Sub