Sub Сохранить()

  UserResponse = MsgBox("Хотите сохранить документ?", vbYesNo)
    If UserResponse = vbYes Then

Range("X2").Select
    Selection.Copy
    Range("X1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("X1").Select
    ActiveCell.Replace What:="""", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Find(What:="""", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
        Columns("O:X").Select
    Selection.EntireColumn.Hidden = True
    ActiveSheet.Range("$O$20:$O$41").AutoFilter Field:=1, Criteria1:="=1", _
        Operator:=xlOr, Criteria2:="="
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
Dim wb As Workbook, sName As String, sPath As String
Application.DisplayAlerts = False
sPath = "C:\Users\User\Desktop\Текущие договора\"
sName = Cells(1, 24).Value
Set wb = ThisWorkbook
wb.ActiveSheet.Copy
Set wbCopySheet = ActiveWorkbook
Dim oSh As Object
For Each oSh In ActiveSheet.Shapes
   oSh.Delete
Next
 Columns("N:Y").Select
    Selection.EntireColumn.Hidden = False
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("A1:X18").Select
    Selection.Copy
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 1
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B1").Select

wbCopySheet.SaveAs Filename:=sPath & sName & ".xlsx", FileFormat:=51
wbCopySheet.Close
Application.DisplayAlerts = True
MsgBox ("Файл сохранен: " & Range("x1").Value)
 Else
 MsgBox "Документ не сохранен!"
  End If

End Sub