マルチページ内に入力フォームを設置して宛名リストを作る

Private Sub 宛名リスト整頓_Click()
        Call Module3.宛名リストの整頓
End Sub

Private Sub 入力クリア_Click()
        With 宛名印刷設定
            .宛名名.Value = ""
            .敬称.Value = ""
            .所属先名.Value = ""
            .前3桁.Value = ""
            .後4桁.Value = ""
            .都道府県名.Value = ""
            .市区町村名.Value = ""
            .番地他名.Value = ""
            .BM.Value = ""
            .連絡番号.Value = ""
        End With
End Sub

Private Sub 発送先登録_Click()
        Call Module3.宛名追加
End Sub

Sub 宛名リストの整頓()
    Dim ans, s, ATRow As Long
        ans = MsgBox("1行目に項目名、A列にリスト通番が打たれます。" _
            & vbCrLf & "実行していいですか？", vbYesNo _
                + vbQuestion, "確認")
        If ans = vbYes Then
            With Worksheets("宛名リスト")
                .Range("B1") = "宛名"
                .Range("C1") = "敬称"
                .Range("D1") = "所属先名"
                .Range("E1") = "郵便番号"
                .Range("F1") = "都道府県"
                .Range("G1") = "市区町村"
                .Range("H1") = "番地"
                .Range("I1") = "ビル・マンション名"
                .Range("J1") = "連絡番号"
                ATRow = .Cells(Rows.Count, 2).End(xlUp).Row
                For s = 2 To ATRow
                    .Range("A" & s) = s - 1
                Next s
                .Columns.AutoFit
                .Select
                .Range("A1").Select
            End With
        Else
            Exit Sub
        End If
End Sub

Sub 宛名追加()
    Dim ATRow As Long
        Workbooks("封筒宛名印字.xlsm").Activate
        With Worksheets("宛名リスト")
            ATRow = .Cells(Rows.Count, 2).End(xlUp).Row
            If 宛名印刷設定.宛名名.Value <> "" Then
                .Range("B" & ATRow + 1) = 宛名印刷設定.宛名名.Value
                .Range("C" & ATRow + 1) = 宛名印刷設定.敬称.Value
                .Range("D" & ATRow + 1) = 宛名印刷設定.所属先名.Value
                .Range("E" & ATRow + 1) = 宛名印刷設定.前3桁.Value _
                            & "-" & 宛名印刷設定.後4桁.Value
                .Range("F" & ATRow + 1) = 宛名印刷設定.都道府県名.Value
                .Range("G" & ATRow + 1) = 宛名印刷設定.市区町村名.Value
                .Range("H" & ATRow + 1) = 宛名印刷設定.番地他名.Value
                .Range("I" & ATRow + 1) = 宛名印刷設定.BM.Value
                .Range("J" & ATRow + 1) = 宛名印刷設定.連絡番号.Value
            Else
                MsgBox "宛名が未記入です。" & vbCrLf & _
                    "登録を中止して終了します。", vbCritical, "封筒宛名印刷"
                Exit Sub
            End If
                .Select
                .Range("B" & ATRow + 1).Select
        End With
End Sub