Sub Test()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayStatusBar = False
Application.DisplayAlerts = False

Dim Dest As Workbook
Dim Source As Range
Dim ConstFilePath As String
Dim ConstFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim n As String

A = WorksheetFunction.Match("TypeDoma", [ФЛ_Ф_056!a1:ww1], 0)
B = WorksheetFunction.Match("TypUL", [ФЛ_Ф_056!a1:ww1], 0)
C = WorksheetFunction.Match("LS", [ФЛ_Ф_056!a1:ww1], 0)
J = WorksheetFunction.Match("VOL_IND", [ФЛ_Ф_056!a1:ww1], 0)
D = WorksheetFunction.Match("N_SERV", [ФЛ_Ф_056!a1:ww1], 0)
E = WorksheetFunction.Match("SQUARE", [ФЛ_Ф_056!a1:ww1], 0)
F = WorksheetFunction.Match("ROOMS", [ФЛ_Ф_056!a1:ww1], 0)
G = WorksheetFunction.Match("MAN_COUNT", [ФЛ_Ф_056!a1:ww1], 0)
H = WorksheetFunction.Match("STATUS", [ФЛ_Ф_056!a1:ww1], 0)


Set Source = Nothing
On Error Resume Next
Set Source = Union(Columns(A), Columns(B), Columns(C), Columns(J), Columns(D), Columns(E), Columns(F), Columns(G), Columns(H))
On Error GoTo 0
 
If Source Is Nothing Then
    MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
    Exit Sub
End If

Set Dest = Workbooks.Add(xlWBATWorksheet)
    Source.Copy
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
    End With



With Dest
      .SaveAs ConstFilePath & ConstFileName & FileExtStr
On Error Resume Next
End With

Dest.Close savechanges:=True

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayStatusBar = True
Application.DisplayAlerts = True

End Sub