Dim arrP() As String

Sub Test1()
'    Dim arrP() As String
    Dim arrP As Variant
    Dim P
    P = "P20 P44 P64 P83"
    arrP = Split(P)
    ReDim Preserve arrP(UBound(arrP) + 1)
    ReDim Preserve arrP(1 To UBound(arrP))
End Sub

Private Sub CommandButton1_Click()
    Worksheets("Выписка").Activate
    Dim Data As String
    Dim FioP As String
    Dim FioM As String
    Dim TypeN As String
    Dim Srok As String
    Dim Summa As String
    Dim Phone As String
    Dim StoimS As String
    НомерСтроки = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
    With UserForm1
        Data = .TextBox1.Text
        FioP = .TextBox2.Text
        Srok = .TextBox5.Text
        Phone = .TextBox7.Text
        TextBox6.Text = TextBox9.Text * TextBox5.Text
        If OptionButton1.Value = True Then TextBox6.Text = TextBox6.Text - (TextBox6.Text * 0.03)
        If OptionButton2.Value = True Then TextBox6.Text = TextBox6.Text - (TextBox6.Text * 0.05)
        If OptionButton3.Value = True Then TextBox6.Text = TextBox6.Text - (TextBox6.Text * 0.07)
        Summa = TextBox6.Text
        If CheckBox1.Value = True Then TextBox8.Text = Worksheets("Менеджеры").Range("B1").Value
        If CheckBox1.Value = True Then FioM = TextBox8.Text
        If CheckBox2.Value = True Then TextBox8.Text = Worksheets("Менеджеры").Range("B10").Value
        If CheckBox2.Value = True Then FioM = TextBox8.Text
        If CheckBox3.Value = True Then TextBox9.Text = Worksheets("Апартаменты").Range("B4").Value
        If CheckBox3.Value = True Then StoimS = Worksheets("Апартаменты").Range("B4").Value
        If CheckBox3.Value = True Then TypeN = "Стандартный"

        If CheckBox3.Value = True Then GoSub Search1

        If CheckBox4.Value = True Then TextBox9.Text = Worksheets("Апартаменты").Range("B10").Value
        If CheckBox4.Value = True Then StoimS = Worksheets("Апартаменты").Range("B10").Value
        If CheckBox4.Value = True Then TypeN = "Студия"
        If CheckBox5.Value = True Then TextBox9.Text = Worksheets("Апартаменты").Range("B18").Value
        If CheckBox5.Value = True Then StoimS = Worksheets("Апартаменты").Range("B18").Value
        If CheckBox5.Value = True Then TypeN = "Семейный"
        If CheckBox6.Value = True Then TextBox9.Text = Worksheets("Апартаменты").Range("B25").Value
        If CheckBox6.Value = True Then StoimS = Worksheets("Апартаменты").Range("B25").Value
        If CheckBox6.Value = True Then TypeN = "Люкс"
    End With
    With Worksheets("Выписка")
        Cells(НомерСтроки, 1).Value = Data
        Cells(НомерСтроки, 2).Value = FioP
        Cells(НомерСтроки, 3).Value = FioM
        Cells(НомерСтроки, 4).Value = TypeN
        Cells(НомерСтроки, 5).Value = Srok
        Cells(НомерСтроки, 6).Value = Summa
        Cells(НомерСтроки, 7).Value = Phone
    End With
    Exit Sub
Search1:
    Dim x As String
    Dim found As Boolean
    Cells(2, 4).Select
    x = "Стандартный"
    found = False
    Do Until IsEmpty(ActiveCell)
        If ActiveCell.Value = x Then
            found = True
            Exit Do
        End If
        ActiveCell.Offset(1, 0).Select
    Loop
    If found = True Then
        GoSub allert
    End If
    Return
allert:
    Dim a As Integer
    a = MsgBox("Все номера выбранного типа заняты", vbOKCancel)
    If a = vbCancel Then Exit Sub
    Return
End Sub

фигура.Name = Cells(4, 4) & " " & Cells(4, 3)

Sub ConvertDoc()
    Const rowsOne = 25&
    Const rowsStep = 29&
    Dim n&, DocExcelMaxRow&
    '    ПутьШаблона = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, ИмяФайлаШаблона)
    '    FileName = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "NewDoc" & Get_Time & РасширениеСоздаваемыхФайлов)

    '    DocExcelMaxColomn = Cells.SpecialCells(xlLastCell).Column
    DocExcelMaxRow = 153    'Cells(Rows.Count, "A").End(xlUp).Row

    Dim WA As Object, WD As Object
    '    Set WA = CreateObject("Word.Application")    ' без подключения библиотеки Word
    Dim Table1 As Object
    Set WA = Application    ' без подключения библиотеки Word

    '    Set WD = WA.Documents.Add(ПутьШаблона)
    Set WD = WA.ActiveDocument
    WD.PageSetup.TopMargin = Application.CentimetersToPoints(3.7)    'отступ сверху
    WD.PageSetup.LeftMargin = Application.CentimetersToPoints(2.2)    'отступ слева

    '           Set Table1 = WD.Tables.Add(WD.Range(Start:=0, End:=0), 24, 9)  'рабочая
    Set Table1 = WD.Tables.Add(WD.Range(Start:=0, End:=0), DocExcelMaxRow, 9)  'рабочая

    With Table1
        .Borders.OutsideLineStyle = 1  'Работает
        .Borders.InsideLineStyle = 1   'Работает
        .Rows.Height = Application.CentimetersToPoints(0.8)
        .Columns(1).Width = Application.CentimetersToPoints(2)    '1-й столбец
        .Columns(2).Width = Application.CentimetersToPoints(13)    '2-й столбец
        .Columns(3).Width = Application.CentimetersToPoints(6)    '3-й столбец
        .Columns(4).Width = Application.CentimetersToPoints(3.5)    '4-й столбец
        .Columns(5).Width = Application.CentimetersToPoints(4.5)    '5-й столбец
        .Columns(6).Width = Application.CentimetersToPoints(2)    '6-й столбец
        .Columns(7).Width = Application.CentimetersToPoints(2)    '7-й столбец
        .Columns(8).Width = Application.CentimetersToPoints(2.5)    '8-й столбец
        .Columns(9).Width = Application.CentimetersToPoints(4)    '9-й столбец

        n = rowsOne
        Do While n < DocExcelMaxRow - 1
            .Cell(n, 1).Select
            Selection.ParagraphFormat.PageBreakBefore = wdToggle
            n = n + rowsStep
            DoEvents
        Loop

        .Cell(1, 2) = "nnn"
        .Cell(1, 3) = "55ggg"
    End With

    '            WD.SaveAs FileName
    '
    '    WD.Close False    ' False - без сохранения
    '    WA.Quit False
    '    MsgBox "Выгружено в word."

End Sub

Private Sub Сортировка()
'Application.ScreenUpdating = False
'Application.EnableEvents = False

'    Range("B10:C19").Select   ЭТА СТРОКА ЛИШНЯЯ

    ActiveWorkbook.Worksheets("Лист2").sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Лист2").sort.SortFields.Add Key:=Range("B10:B19"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Лист2").sort
        .SetRange Range("B10:C19")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
'Application.ScreenUpdating = True
'Application.EnableEvents = True
End Sub