Как написать макрос для копирования данных из нескольких комбинированных списков на лист

Question

У меня есть пользовательская форма с несколькими выпадающими списками, которые я хочу использовать для записи данных на лист. Как мне написать код в al oop, чтобы мне не приходилось писать его для всех 60 случаев? Ниже приведен пример того, что у меня есть:

Отредактировано, чтобы добавить весь саб:

Private Sub FltData_Click()

    'Check for empty date boxes
    Dim IsEmptyDateBox As Boolean
    IsEmptyDateBox = IsBlankDateBox()

    If IsEmptyDateBox = True Then
        MsgBox "Empty Date Box Detected"
    End If

    'Check for complete training boxes
    Dim IsEmptyTextBox As Boolean
    IsEmptyTextBox = IsBlankTextBox()

    If IsEmptyTextBox = True Then
        MsgBox "Incomplete Training Info Detected"
    End If

    'Input date function
    Dim DateSelect As String
    Dim Month As String
    Dim Day As String
    Dim Year As String

    If DateMonth.Value = "January" Then
        Month = "01"
        Elseif DateMonth.Value = "February" Then
        Month = "02"
        Elseif DateMonth.Value = "March" Then
        Month = "03"
        Elseif DateMonth.Value = "April" Then
        Month = "04"
        Elseif DateMonth.Value = "May" Then
        Month = "05"
        Elseif DateMonth.Value = "June" Then
        Month = "06"
        Elseif DateMonth.Value = "July" Then
        Month = "07"
        Elseif DateMonth.Value = "August" Then
        Month = "08"
        Elseif DateMonth.Value = "September" Then
        Month = "09"
        Elseif DateMonth.Value = "October" Then
        Month = "10"
        Elseif DateMonth.Value = "November" Then
        Month = "11"
        Elseif DateMonth.Value = "December" Then
        Month = "12"
    End If

    Day = DateDay.Value
    Year = DateYear.Value
    DateSelect = Month + "/" + Day + "/" + Year

    'Is data already inputed/eliminate duplicates
    Call DuplicateCheck

    'Select FltData worksheet
    Worksheets("FltData").Select

    'Select blank row after last entry
    LastRow = Worksheets("FltData").UsedRange.SpecialCells(xlCellTypeLastRow).Row
    Cells(LastRow + 1,1).Select

    'Input UserForm info to Worksheet
    ActiveCell.Value = DateSelect
    ActiveCell.Offset(, 1).Value = Time1.Value
    ActiveCell.Offset(, 2).Value = Crew1.Value
    ActiveCell.Offset(, 3).Value = TR1.Value
    ActiveCell.Offset(, 4).Value = Status1.Value

    If Time2.Value <> "" Then
        ActiveCell.Offset(1, 0).Value = DateSelect
        ActiveCell.Offset(1, 1).Value = Time2.Value
        ActiveCell.Offset(1, 2).Value = Crew2.Value
        ActiveCell.Offset(1, 3).Value = TR2.Value
        ActiveCell.Offset(1, 4).Value = Status2.Value
    End If

    If Time3.Value <> "" Then
        ActiveCell.Offset(2, 0).Value = DateSelect
        ActiveCell.Offset(2, 1).Value = Time3.Value
        ActiveCell.Offset(2, 2).Value = Crew3.Value
        ActiveCell.Offset(2, 3).Value = TR3.Value
        ActiveCell.Offset(2, 4).Value = Status3.Value
    End If

    If Time4.Value <> "" Then
        ActiveCell.Offset(3, 0).Value = DateSelect
        ActiveCell.Offset(3, 1).Value = Time4.Value
        ActiveCell.Offset(3, 2).Value = Crew4.Value
        ActiveCell.Offset(3, 3).Value = TR4.Value
        ActiveCell.Offset(3, 4).Value = Status4.Value
    End If

    Call SortByDateTime

End Sub

...

Я думаю, я нашел способ получить это сделано с помощью Me.Controls:

Dim x As Integer
Dim y As Integer
Dim z As Integer

x = 1
y = 2

For y = 2 To 48
    If Me.Controls("Time" & y).Value <> "" Then
        ActiveCell.Offset(x, 0).Value = DateSelect
        ActiveCell.Offset(x, 1).Value = Me.Controls("Time" & y).Value
        ActiveCell.Offset(x, 2).Value = Me.Controls("Crew" & y).Value
        ActiveCell.Offset(x, 3).Value = Me.Controls("TR" & y).Value
        ActiveCell.Offset(x, 4).Value = Me.Controls("Status" & y).Value
    End If
    x = x + 1
Next y