Sub denpyosakusei()
    Worksheetsdelete
    Dim shFm As Worksheet
    Set shFm = Worksheets("main")
    Dim cFm
    Dim shName
    Dim shTo As Worksheet
    Dim cTo
    For cFm = 2 To shFm.Range("B65536").End(xlUp).Row
        shFm.Range("A" & cFm).Value = cFm - 1
    Next
    shFm.Range("A1").Value = "通番"
    With shFm
        .Range("A1").Sort key1:=.Range("B1"), Order1:=xlAscending, Header:=xlYes
    End With
    For cFm = 2 To shFm.Range("B65536").End(xlUp).Row
        If shFm.Range("B" & cFm).Value <> shFm.Range("B" & cFm - 1).Value Then
            cTo = 16
            shName = shFm.Range("B" & cFm).Value
            Worksheets("main1").Copy After:=ActiveSheet
            ActiveSheet.Name = shName
        End If
        Set shTo = Worksheets(shName)
        shTo.Range("E" & cTo).Value = shFm.Range("D" & cFm).Value
        shTo.Range("F" & cTo).Value = shFm.Range("E" & cFm).Value
        shTo.Range("H" & cTo).Value = shFm.Range("F" & cFm).Value
        shTo.Range("B" & cTo).Value = Left(shFm.Range("C" & cFm).Value, 4)
        shTo.Range("C" & cTo).Value = Mid(shFm.Range("C" & cFm).Value, InStr(shFm.Range("C" & cFm).Value, "/") + 1, 2)
        shTo.Range("D" & cTo).Value = Right(shFm.Range("C" & cFm).Value, 2)
        If shFm.Range("G" & cFm).Value < 0 Then
            shTo.Range("I" & cTo).Value = 0 - shFm.Range("G" & cFm).Value
        Else
            shTo.Range("J" & cTo).Value = shFm.Range("G" & cFm).Value
        End If
        cTo = cTo + 1
        shTo.Range("B16" & ":K" & shTo.Range("H65536").End(xlUp).Row).Select
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With Selection.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
    Next
    shFm.AutoFilter.Sort.SortFields.Clear
    shFm.AutoFilter.Sort.SortFields.Add2 _
    Key:=Range("A1"), _
    SortOn:=xlSortOnValues, _
    Order:=xlAscending, _
    DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("main").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    shFm.Activate
    shFm.Range("A2" & ":A" & shFm.Range("B65536").End(xlUp).Row).ClearContents
End Sub

Sub Worksheetsdelete()
    Dim sh As Worksheet
    Application.DisplayAlerts = False
    For Each sh In Worksheets
        If Left(sh.Name, 4) <> "main" Then
            sh.Delete
        End If
    Next
End Sub