Option Explicit
Dim sRetsu As String

Public Sub CreateDenpyo()
    InputNo
    
    sRetsu = "B"
    SortMainSheet
    
    DeleteSheets
    CalledCreateDenpyo
    
    sRetsu = "A"
    SortMainSheet
    
    DeleteNo
End Sub
Private Sub CalledCreateDenpyo()
    Dim lngGyo As Long
    Dim lngMaxGyo As Long
    Dim strCltName As String
    Dim wsMa As Worksheet
    Dim wsMa1 As Worksheet
    Dim wsClt As Worksheet
    Dim dt As Date
    Dim lngToGyo As Long
    lngMaxGyo = Range("B" & Rows.Count).End(xlUp).Row
    For lngGyo = 2 To lngMaxGyo
        Set wsMa = Worksheets("main")
        If strCltName <> wsMa.Range("B" & lngGyo).Value Then
            If lngGyo <> 2 Then
                DrawKeisen
            End If
            strCltName = wsMa.Range("B" & lngGyo).Value
            Set wsMa1 = Worksheets("main1")
            wsMa1.Copy after:=Worksheets(Worksheets.Count)
            Set wsClt = ActiveSheet
            wsClt.Name = strCltName
            lngToGyo = 16
        End If
        wsClt.Range("H" & lngToGyo).Value = wsMa.Range("F" & lngGyo).Value
        wsClt.Range("E" & lngToGyo).Value = wsMa.Range("D" & lngGyo).Value
        wsClt.Range("F" & lngToGyo).Value = wsMa.Range("E" & lngGyo).Value
        If wsMa.Range("G" & lngGyo).Value > 0 Then
            wsClt.Range("I" & lngToGyo).Value = wsMa.Range("G" & lngGyo).Value
        Else
            wsClt.Range("J" & lngToGyo).Value = wsMa.Range("G" & lngGyo).Value
        End If
        dt = wsMa.Range("C" & lngGyo).Value
        '以下は、format関数を使った例です。参考までに。
        wsClt.Range("B" & lngToGyo).Value = Format(dt, "yy") ' Right(Year(dt), 2)
        wsClt.Range("C" & lngToGyo).Value = Format(dt, "mm") 'Month(dt)
        wsClt.Range("D" & lngToGyo).Value = Format(dt, "dd") 'Day(dt)
        If lngToGyo = 16 Then
            wsClt.Range("K" & lngToGyo).Value = wsMa.Range("G" & lngGyo).Value
        Else
            wsClt.Range("K" & lngToGyo).Value = wsMa.Range("G" & lngGyo).Value + wsClt.Range("K" & lngToGyo - 1).Value
        End If
        lngToGyo = lngToGyo + 1
    Next
    DrawKeisen
    wsMa.Activate
End Sub
Public Sub DeleteSheets()
    Application.DisplayAlerts = False
    Dim ws As Worksheet
    For Each ws In Worksheets
        If Left(ws.Name, 4) <> "main" Then
            ws.Delete
        End If
    Next
    Application.DisplayAlerts = True
End Sub
Private Sub DrawKeisen()
    Dim lngLastGyo As Long
    lngLastGyo = Range("B" & Rows.Count).End(xlUp).Row
    With Range("B16:K" & lngLastGyo + 1).Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    ActiveSheet.PageSetup.PrintArea = "A1:K" & lngLastGyo
    Range("A1").Select
End Sub
Private Sub InputNo()
    Dim lngLastRow As Long
    Worksheets("main").Activate
    Range("A1").Value = "No."
    lngLastRow = Range("B" & Rows.Count).End(xlUp).Row
    With Range("A2")
        .Value = 1
        .AutoFill Destination:=Range("A2:A" & lngLastRow), Type:=xlFillSeries
    End With
End Sub
Private Sub SortMainSheet()
    Dim lngLastRow As Long
    lngLastRow = Worksheets("main").Range("B" & Rows.Count).End(xlUp).Row
'    With Worksheets("main").Sort.SortFields
'        .Clear
'        .Add Key:=Range(sRetsu & "2:" & sRetsu & lngLastRow), _
'            SortOn:=xlSortOnValues, _
'            Order:=xlAscending, _
'            DataOption:=xlSortNormal
'    End With
'    With Worksheets("main").Sort
'        .SetRange Range("A1:G" & lngLastRow)
'        .Header = xlYes
'        .Apply
'    End With
    'あえて言うなら以下の書き方のほうがやや良いか
    With Worksheets("main").Sort
        With .SortFields
            .Clear
            .Add Key:=Range(sRetsu & "2:" & sRetsu & lngLastRow), _
                SortOn:=xlSortOnValues, _
                Order:=xlAscending, _
                DataOption:=xlSortNormal
        End With
        .SetRange Range("A1:G" & lngLastRow)
        .Header = xlYes
        .Apply
    End With
End Sub
Private Sub DeleteNo()
    With Worksheets("main")
        .Columns("A").Clear
        .Range("A1").Select
    End With
End Sub