Цикл конструкции Do While

[Trimbl]

Уважаемые форумчане, здравствуйте!
Подскажите пожалуйста как доработать макрос CommandButton чтобы при формировании табеля оставались имена исполнителей(ниже таблицы). Прилагаю свой вариант(файл Табель1), но в нем две загвоздки:1.Ширина строк увеличивается в 3 раза 2. Создается слишком большой отступ от нижней границы таблицы. Думаю, что вся проблема в моем недопонимании "работы" цикла Do While.
Благодарю за внимание.

[Hugo121]

C "костылями" так:

Private Sub CommandButton1_Click()
    UF.Hide
    Dim n As Integer
    Dim x As Integer
    Dim indxList As Integer
    Dim MyDate1 As String
    Dim MyDate2 As String
    Dim intDate(1 To 2) As ComboBox
    Dim i As Long

    i = Cells(Rows.Count, 1).End(xlUp).Row
    Range(Rows("14"), Rows(i - 4)).Select
    Selection.Delete Shift:=xlUp
    i = Cells(Rows.Count, 1).End(xlUp).Row
    Rows(i - 3).Select
    Selection.Insert Shift:=xlDown
   
    Rows(i - 3).RowHeight = Rows(i - 2).RowHeight

    Set intDate(1) = Me.cmbMonth
    Set intDate(2) = Me.cmbYear

    DataUF = intDate(1) & " " & intDate(2)
    Cells(11, 13).Value = intDate(1).Value & " " & intDate(2).Value & " года"

    m = Range("A13").CurrentRegion.Rows.Count
    m = m + 12
    Application.Calculation = xlCalculationManual
    'Application.ScreenUpdating = False
    n = 6
    Do While Лист1.Cells(n, 1) <> Empty
        Cells(m, 1) = Лист1.Cells(n, 1)
        Cells(m, 2) = Лист1.Cells(n, 2)
        Cells(m, 1).Borders.Weight = xlMedium
        Cells(m, 2).Borders.Weight = xlMedium

        x = 3
        For Each cntrlArr In Me.Controls
            If (cntrlArr.Tag = "Day" Or cntrlArr.Tag = "Holliday") And cntrlArr.Visible = True Then
                If cntrlArr.SpecialEffect = 2 Then
                    With Cells(m, x)
                        .Value = "В"
                        .Borders.Weight = xlThin
                        .Interior.Color = RGB(153, 204, 255)
                    End With
                    x = x + 1
                ElseIf cntrlArr.SpecialEffect = 1 Then
                    With Cells(m, x)
                        .Value = "Я"
                        .Borders.Weight = xlThin
                    End With
                    If Лист1.Cells(n, 3) = "суммарный" Then
                        With Cells(m, x)
                            .Value = "8"
                        End With
                    End If
                    x = x + 1
                End If
            End If
        Next

        If Лист1.Cells(n + 1, 1) <> Empty Then
            i = Cells(Rows.Count, 1).End(xlUp).Row
            Rows(i - 3).Select
            Selection.Insert Shift:=xlDown
        End If

        m = m + 1
        n = n + 1
    Loop
End Sub

Добавил

Rows(i - 3).RowHeight = Rows(i - 2).RowHeight


If Лист1.Cells(n + 1, 1) <> Empty Then
...
End If

Остальное не трогал и не вникал...

[Trimbl]

Hugo121, Спасибо. C "костылями" "пашет"