Option Explicit
Dim i As Long, LastRow As Long, LastCol As Long
Dim x As Object, RngCol As Range

Private Sub Btn_Отмена_Click()
    Unload Me
End Sub

Private Sub CommandButton2_Click()
    Application.ScreenUpdating = False    ' выключили обновление экрана
    On Error Resume Next

    '          проверка на заполнение полей
    For Each x In Me.Controls

        If TypeOf x Is MSForms.TextBox Or TypeOf x Is MSForms.ComboBox Then

            If x.Value = "" Then
                MsgBox "Все обязательные поля должны быть заполнены!", 48, "Сообщение"
                Exit Sub
            End If

        End If

    Next

    With Sheet3    '          перенос данных с формы на лист
        LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        .Cells(LastRow + 1, 1) = Me.Cmb_Месяц
        .Cells(LastRow + 1, 2) = Me.Cmb_Год
        .Cells(LastRow + 1, 3) = CDbl(Me.txt_Изделие)
        .Cells(LastRow + 1, 4) = Me.Cmb_Партия
        .Cells(LastRow + 1, 5) = CDbl(Me.txt_Коэф)
        .Cells(LastRow + 1, 6) = Me.Cmb_ФИО
        .Cells(LastRow + 1, 7) = Me.Cmb_PP

        Set RngCol = .Rows(1).Find(Me.Cmb_День.Text, , xlFormulas, xlWhole)                        ' ячейка в первой строке выбранного дня
        .Cells(LastRow + 1, RngCol.Column) = Me.txt_Часы.Value

        '          форматирование таблицы
        .Range(.Cells(2, 1), .Cells(LastRow + 1, 29)).Borders.LineStyle = xlContinuous             ' обрамление ячеек
        .Range(Cells(2, 1), Cells(LastRow + 1, 29)).HorizontalAlignment = xlCenter                 ' выравнивание
        .Range(Cells(2, 1), Cells(LastRow + 1, 29)).VerticalAlignment = xlCenter
        Range("Таблица1[год]").NumberFormat = "yyyy"
    End With

    Application.ScreenUpdating = True    ' включили обновление экрана
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    Dim iPart As Long, iFIO As Long, iPP As Long

    For i = 1 To 12
        Me.Cmb_Месяц.AddItem Format(DateSerial(1, i, 1), "MMMM")
    Next

    Me.Cmb_Год.List = Array("2021", "2022", "2023")
    Me.Cmb_Год.ListIndex = 0

    With Sheet2
        iPart = .Cells(Rows.Count, 1).End(xlUp).Row
        iFIO = .Cells(Rows.Count, 2).End(xlUp).Row
        iPP = .Cells(Rows.Count, 3).End(xlUp).Row
        Me.Cmb_Партия.List = .Range("a2:a" & iPart).Value
        Me.Cmb_ФИО.List = .Range("b2:b" & iFIO).Value
        Me.Cmb_PP.List = .Range("c2:c" & iPP).Value
    End With

    With Sheet3
        Dim myArray() As Variant
        myArray = Range("H1:AC1")
        myArray = WorksheetFunction.Transpose(myArray)

        With UserForm1
            .Cmb_День.List = myArray
        End With

    End With

End Sub