ユーザーフォームの入力項目をバックアップするVBA

Option Explicit

Sub 抽選項目バックアップ()
    Dim i, j As Long
        Set BUsheet = Worksheets("抽選項目BU")
        BUsheet.Select
        Cells.Clear
        For i = 101 To 109
           Cells(1, 1) = "抽選項目"
           Cells(1, 2) = "設定値"
           Cells(1, 3) = "当選本数"
           Cells(i - 100 + 1, 1) = 選定ナビ.Controls("Label" & i).Caption
        Next i
        Range("B2") = TItle
        Range("B3") = Par
        Range("B4") = EVD
        For j = 1 To 6
            Range("B" & 4 + j) = PrN(j)
            Range("C" & 4 + j) = PrQ(j)
        Next j
        Columns("A:C").AutoFit
End Sub

Sub 抽選項目バックアップ旧データ()
    Dim i As Long
        Set BUsheet = Worksheets("抽選項目BU")
        Set TYsheet = Worksheets("抽選会場")
        TYsheet.Select
        If Range("A1") = "" Then Exit Sub
        BUsheet.Select
        Call Module4.賞名空白対処
        For i = 1 To 10
            Range("A" & 12 + i) = "旧 " & Range("A" & i)
            Range("B" & 12 + i) = Range("B" & i)
            Range("C" & 12 + i) = Range("C" & i)
        Next i
        With 選定ナビ
            Range("B2") = .抽選名称.Value
            Range("B3") = .参加人数.Value
            Range("B4") = .開催日付.Value
            Range("B5") = .一位賞.Value
            Range("B6") = .二位賞.Value
            Range("B7") = .三位賞.Value
            Range("B8") = .四位賞.Value
            Range("B9") = .五位賞.Value
            Range("B10") = .六位賞.Value
            Range("C5") = .一位本.Value
            Range("C6") = .二位本.Value
            Range("C7") = .三位本.Value
            Range("C8") = .四位本.Value
            Range("C9") = .五位本.Value
            Range("C10") = .六位本.Value
        End With
        Columns("A:C").AutoFit
End Sub

Sub 抽選項目更新()
    Dim i, j, k As Long
    Dim FArow As Long
        Set BUsheet = Worksheets("抽選項目BU")
        Set TYsheet = Worksheets("抽選会場")
        TYsheet.Select
        If Range("A1") = "" Then Exit Sub
        BUsheet.Select
        TItle = Range("B2")
        Par = Range("B3")
        EVD = Range("B4")
        Call Module4.賞名空白対処
        For i = 1 To 6
            PrN(i) = Range("B" & 4 + i)
            PrQ(i) = Range("C" & 4 + i)
            PrQn(i) = val(StrConv(PrQ(i), vbNarrow))
            TYsheet.Range("C" & 4 + i) = PrQn(i) - TYsheet _
                .Range("B" & 4 + i)
        Next i
        TYsheet.Select
        If Range("A1") = "" Then
            Range("C:C").ClearContents
        End If
        For j = 1 To 6
            TYsheet.Range("A" & 4 + j) = BUsheet. _
                Range("B" & 4 + j)
        Next j
'抽選会場当選結果、賞名のさかのぼり修正
        FArow = TYsheet.Cells(Rows.Count, 1).End(xlUp).Row
        BUsheet.Select
        For j = 1 To 6
            If Range("B" & 4 + j) <> Range("B" & 16 + j) Then
                For k = 12 To FArow
                    If TYsheet.Range("A" & k) = BUsheet _
                        .Range("B" & 16 + j) Then
                        TYsheet.Range("A" & k) = BUsheet _
                            .Range("B" & 4 + j)
                    End If
                Next k
            End If
        Next j
        TYsheet.Select
End Sub

Sub 賞名空白対処()
    Dim i As Long
        For i = 1 To 6
        
            If 選定ナビ.一位賞.Value = "" And _
                選定ナビ.一位本.Value <> "" Then
                        選定ナビ.一位賞.Value = "(仮)1位賞"
            ElseIf 選定ナビ.二位賞.Value = "" And _
                選定ナビ.二位本.Value <> "" Then
                        選定ナビ.二位賞.Value = "(仮)2位賞"
            ElseIf 選定ナビ.三位賞.Value = "" And _
                選定ナビ.三位本.Value <> "" Then
                        選定ナビ.三位賞.Value = "(仮)3位賞"
            ElseIf 選定ナビ.四位賞.Value = "" And _
                選定ナビ.四位本.Value <> "" Then
                        選定ナビ.四位賞.Value = "(仮)4位賞"
            ElseIf 選定ナビ.五位賞.Value = "" And _
                選定ナビ.五位本.Value <> "" Then
                        選定ナビ.五位賞.Value = "(仮)5位賞"
            ElseIf 選定ナビ.六位賞.Value = "" And _
                選定ナビ.六位本.Value <> "" Then
                        選定ナビ.六位賞.Value = "(仮)6位賞"
            End If
        Next i
End Sub

Sub 当選者リスト作成()
    Dim LCRow As Long
        Set TYsheet = Worksheets("抽選会場")
        Set TOsheet = Worksheets("当選者")
        If TYsheet.Range("A1") = "" Then Exit Sub
        TOsheet.Select
        Cells.Clear
        TYsheet.Select
        LCRow = TYsheet.Cells(Rows.Count, 3).End(xlUp).Row
        Range(Cells(3, 1), Cells(LCRow, 3)).Copy TOsheet.Range("A3")
        TOsheet.Select
        With TOsheet
            .Columns("A:C").AutoFit
'選定ナビ.抽選名称.Value
            .Range("A1") = TItle
'選定ナビ.開催日付.Value
            .Range("C1") = EVD
'選定ナビ.参加人数.Value & "人(口)"
            .Range("A2") = Par & "人（口）"
            With .Range("A1,A2,C1").Font
                .Bold = True
                .Size = 13
            End With
        End With
        TYsheet.Select
End Sub