Option Explicit
'モジュールレベル変数はデフォルトprivate (Dim hoge で、 Private hoge と書いたときと同じ意味)
'プロシージャはデフォルトpublic

'モジュールレベル変数をpublicにするのは、他のモジュールからも呼び出したいときです
'プロシージャをprivateにするのは、他のモジュールから呼び出されたくないときです
Public shFm As Worksheet 'Privateにします。他のモジュールから呼び出したいわけではないので
Public shTo As Worksheet 'Privateにします。他のモジュールから呼び出したいわけではないので
Public lnFmMx As Long    'Privateにします。他のモジュールから呼び出したいわけではないので
Sub zikkou() 'Publicにします。実行ボタンを押したときに呼び出されるようにしたいものなので
    Set shFm = Worksheets("main")
    lnFmMx = shFm.Range("B" & Rows.Count).End(xlUp).Row
    sakuzyo
    bango
    narabikae
    sakusei
    'あとはここで元の表を並べ替えるかどうか ogawa
End Sub


Sub bango() 'Privateにします。 zikkou からのみ呼び出されるので
'autofillを使った書き方も研究してみましょう！ ogawa
'    Set shFm = Worksheets("main")
'    lnFmMx = shFm.Range("B" & Rows.Count).End(xlUp).Row
    
    Dim lnFm As Long
    
    shFm.Range("A1").Value = "No."
    For lnFm = 2 To lnFmMx
        shFm.Range("A" & lnFm).Value = lnFm - 1
    Next
End Sub

Sub narabikae() 'Privateにします。 zikkou からのみ呼び出されるので
'    Set shFm = Worksheets("main")
'    lnFmMx = shFm.Range("B" & Rows.Count).End(xlUp).Row
    
    'shFm.Sort や shFm.SOrt.SOftFields で with を使ってまとめてみましょう ogawa
    shFm.Sort.SortFields.Clear
    shFm.Sort.SortFields.Add2 _
        Key:=Range("B2:B" & lnFmMx), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
    With shFm.Sort
        .SetRange Range("A1:G" & lnFmMx)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    shFm.Range("A1").Select
End Sub

Sub sakusei() 'Privateにします。 zikkou からのみ呼び出されるので
'    Set shFm = Worksheets("main")
'    lnFmMx = shFm.Range("B" & Rows.Count).End(xlUp).Row
    
    Dim lnTo As Long
    Dim lnFm As Long
    Dim st As String
    Dim dt As Date
    
    For lnFm = 2 To lnFmMx
        If shFm.Range("B" & lnFm).Value <> shFm.Range("B" & lnFm - 1).Value Then
            If lnFm <> 2 Then
                koushisen
            End If
            st = shFm.Range("B" & lnFm).Value
            Sheets("main1").Copy After:=Sheets(2)
            Set shTo = ActiveSheet
            shTo.Name = st
            lnTo = 16
            
        End If
        shTo.Range("E" & lnTo).Value = shFm.Range("D" & lnFm).Value
        shTo.Range("F" & lnTo).Value = shFm.Range("E" & lnFm).Value
        shTo.Range("H" & lnTo).Value = shFm.Range("F" & lnFm).Value
        If shFm.Range("G" & lnFm).Value > 0 Then
            shTo.Range("I" & lnTo).Value = shFm.Range("G" & lnFm).Value
        Else
            shTo.Range("J" & lnTo).Value = shFm.Range("G" & lnFm).Value
        End If
        If lnTo = 16 Then
            shTo.Range("K" & lnTo).Value = shFm.Range("G" & lnFm).Value
        Else
            shTo.Range("K" & lnTo).Value = shFm.Range("G" & lnFm).Value + shTo.Range("K" & lnTo).Offset(-1).Value
        End If
        '↓あえてここに置いたのですか。おもしろいですね。 Format関数を使った書き方を研究してみてください ogawa
        dt = shFm.Range("C" & lnFm).Value
        shTo.Range("B" & lnTo).Value = Right(Year(dt), 2)
        shTo.Range("C" & lnTo).Value = Month(Date)
        shTo.Range("D" & lnTo).Value = Day(dt)
        lnTo = lnTo + 1
    Next
    koushisen
End Sub
Sub koushisen() 'Privateにします。 sakusei からのみ呼び出されるので
    'Set shTo = Worksheets("?{??@??")
    Dim lnToMx As Long
    lnToMx = shTo.Range("B" & Rows.Count).End(xlUp).Row
    With shTo.Range("B16:K" & lnToMx + 1)
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
    End With

End Sub
Sub sakuzyo() 'Publicにします。削除ボタンを押したときに呼び出されるようにしたいものなので
    Dim sh As Worksheet
    
    Application.DisplayAlerts = False
    
    For Each sh In Worksheets
        If Left(sh.Name, 4) <> "main" Then
            sh.Delete
        End If
    Next
    Application.DisplayAlerts = True

End Sub