時給計算表シートを期間毎に名付け保存するVBA

Option Explicit

    Public EmpName As String, 年月日 As String
    Public OriBName As String
    Public TCos, TwCos, TMal, KMal
    Public SD, ED As Variant
    Public KShH As Boolean
    Dim SaName As String, SaNamea As String

Sub 設定値代入()
    Dim MB As Long
        Worksheets("初期設定項目").Select
'会計期間をセット
        Range("D5", "F5").NumberFormatLocal = "dd"
STEP0:
        If Range("D5") = "" Then
            MsgBox "会計期間が未入力です。" & vbCrLf & "入力してください。" _
                        , vbExclamation, "時給計算表作成"
STOP1:
            On Error Resume Next
            SD = Application.InputBox("開始日を入力してください。", _
                        Title:="時給計算表作成", Type:=2)
            On Error GoTo 0
            If SD = False Then
                MsgBox "日付未入力ではテンプレート作成出来ません。", _
                            vbExclamation, "時給計算表作成"
                GoTo STOP1
            ElseIf SD = "" Then
                MsgBox "日付未入力ではテンプレート作成出来ません。", _
                            vbExclamation, "時給計算表作成"
                GoTo STOP1
            ElseIf SD < 1 Or SD > 31 Then
                MsgBox "異常値ではテンプレート作成出来ません。", _
                            vbExclamation, "時給計算表作成"
                GoTo STOP1
            Else
                With Worksheets("初期設定項目")
                    .Range("D5").Value = SD
                End With
            End If
        ElseIf Range("D5") < 1 Or Range("D5") > 31 Then
            MsgBox "異常値ではテンプレート作成出来ません。", _
                        vbExclamation, "時給計算表作成"
            Range("D5") = ""
            GoTo STEP0:
        Else
            With Worksheets("初期設定項目")
                .Range("D5").Value = SD
            End With
        End If
STEP2:
        If Range("F5") = "" Then
            MsgBox "会計期間が未入力です。" & vbCrLf & "入力してください。" _
                        , vbExclamation, "時給計算表作成"
STOP3:
            On Error Resume Next
            ED = Application.InputBox("開始日を入力してください。", _
                        Title:="時給計算表作成", Type:=2)
            On Error GoTo 0
            If ED = False Then
                MsgBox "日付未入力ではテンプレート作成出来ません。", _
                            vbExclamation, "時給計算表作成"
                GoTo STOP3
            ElseIf ED = "" Then
                MsgBox "日付未入力ではテンプレート作成出来ません。", _
                            vbExclamation, "時給計算表作成"
                GoTo STOP3
            ElseIf ED < 1 Or ED > 31 Then
                MsgBox "異常値ではテンプレート作成出来ません。", _
                            vbExclamation, "時給計算表作成"
                GoTo STOP3
            Else
                With Worksheets("初期設定項目")
                    .Range("F5").Value = ED
                End With
            End If
        ElseIf Range("F5") < 1 Or Range("F5") > 31 Then
            MsgBox "異常値ではテンプレート作成出来ません。", _
                        vbExclamation, "時給計算表作成"
            Range("F5") = ""
            GoTo STEP2:
        Else
            With Worksheets("初期設定項目")
                .Range("F5").Value = ED
            End With
        End If
        With Worksheets("初期設定項目")
            SD = .Range("D5").Value
            ED = .Range("F5").Value
        End With
'対象者名を変数に代入します
        EmpName = Worksheets("初期設定項目").Range("C6").Value
'基本時給をセット
        TCos = Worksheets("初期設定項目").Range("C7").Value
'時間外割増率をセット
        TwCos = Worksheets("初期設定項目").Range("F7").Value / 100
'時間マルメをセット
        TMal = Worksheets("初期設定項目").Range("C8").Value
'金額マルメをセット
        KMal = Worksheets("初期設定項目").Range("C9").Value
'計算シートの保存法を取得
        KShH = Worksheets("初期設定項目").Range("E10").Value
End Sub

Option Explicit

Dim MoShN As String

Sub シート保存()
    Dim StD, StM, StY, SMH As Date
    Dim MoSh As Worksheet
    Dim Sh As Worksheet
    Dim res As Boolean
    Dim StpNom As Integer
    Dim n, MsgA, MsgB As Integer
    Dim MoShND As String
    Dim CusName As Variant
        Call Module1.設定値代入
        res = False
'テンプレートシートが準備されているかを調べる
        For Each Sh In ThisWorkbook.Worksheets
            If Sh.Name = EmpName & "時給計算表" Then
                res = True
                Worksheets(EmpName & "時給計算表").Select
                Exit For
            End If
        Next
            If res = False Then
                MsgBox "まだ何も設定されていません。", vbExclamation, _
                            "時給計算表作成"
                Exit Sub
            End If
'テンプレートにデータ入力されているか
        If Range("B3") = "" Then Exit Sub
'時給計算表の書き出し日付を調べます
        With Worksheets(EmpName & "時給計算表")
            StD = Day(.Range("B3"))
            StM = Month(.Range("B3"))
            StY = Year(.Range("B3"))
        End With
'書き出し日付と会計期間（日）の対比をします
        If StD >= SD And StD <= ED Then
            SMH = StM
        ElseIf StD < SD And StD < ED Then
            SMH = StM
        ElseIf StD >= SD And StD >= ED Then
            SMH = StM + 1
        Else
            MsgBox "会計期間（日）設定をチェックしてください。"
        End If
        Worksheets(EmpName & "時給計算表").Select
'計算シートのカスタム保存チェックマークがOFF
        If KShH = False Then
            MsgBox "プログラムの設定ルールで自動保存します。", _
                        vbInformation, "時給計算表作成"
STEP_B:
            If SMH = 13 Then
                SMH = 1
                StY = StY + 1
            End If
'データ型を変更します（整数型に変更）
            MoShN = CInt(StY) & "-" & CInt(SMH)
            Worksheets(EmpName & "時給計算表").Copy _
                        after:=Worksheets(Worksheets.Count)
'保存シート名の最適を決定する
            MoShND = MoShN & "@" & Format(Date, "yyMMDD") & "("
            n = 2
            For Each MoSh In ThisWorkbook.Worksheets
    'ステップ3
                If MoSh.Name Like MoShND & "*" Then
                    StpNom = 3
                    n = n + 1
    'ステップ2
                ElseIf MoSh.Name = MoShN & "@" & _
                                Format(Date, "yyMMDD") Then
                    If StpNom < 2 Then
                        StpNom = 2
                    End If
    'ステップ1
                ElseIf MoSh.Name = MoShN Then
                    If StpNom < 1 Then
                        StpNom = 1
                    End If
                Else
                    If StpNom < 0 Then
                        StpNom = 0
                    End If
                End If
            Next MoSh
'シート名を付ける
            If StpNom = 0 Then
                ActiveSheet.Name = MoShN
            ElseIf StpNom = 1 Then
                ActiveSheet.Name = MoShN & "@" & _
                                    Format(Date, "yyMMDD")
            ElseIf StpNom = 2 Or StpNom = 3 Then
                ActiveSheet.Name = MoShND & n & ")"
            End If
            Exit Sub
'計算シートのカスタム保存チェックマークがON
        ElseIf KShH = True Then
'カスタムでシート名を付けるかを確認する
            MsgA = MsgBox("保存するシート名をカスタムします。" _
                & vbCrLf & "保存名を指定しますか？", vbYesNo + _
                vbExclamation, "時給計算表作成")
            If MsgA = vbNo Then
                MsgBox "シートの保存名をカスタムしません。" & _
                    vbCrLf & "自動保存に移行します。", vbInformation, _
                    "時給計算表作成"
                GoTo STEP_B
            ElseIf MsgA = vbYes Then
STEP_C:
    'ステップ4
                MsgBox "表示する入力ボックスでシート名を" & _
                "指定してください。", vbInformation, "時給計算表作成"
'入力ボックスを表示しシート名を入力する
                CusName = Application.InputBox _
                ("シート名を入力してください。", _
                            Title:="時給計算表作成", Type:=2)
'シート名が入力されない場合の処理コード
                If CusName = "" Or CusName = False Then
                    MsgB = MsgBox("カスタム名でのシート保存を" & _
                        "中止しますか。", vbYesNo + vbExclamation, _
                        "時給計算表作成")
                    If MsgB = vbYes Then
                        MsgBox "シートの保存名をカスタムしません。" _
                            & vbCrLf & "自動保存に移行します。", _
                            vbInformation, "時給計算表作成"
                        GoTo STEP_B
                    Else
                        GoTo STEP_C
                    End If
                End If
                Worksheets(EmpName & "時給計算表").Copy _
                            after:=Worksheets(Worksheets.Count)
                ActiveSheet.Name = CusName
            End If
        End If
End Sub