Option Explicit
Public Sub Denpyo_Sakusei() '「伝票作成」ボタンに割り当て
    No_Saiban
    Sort_Torihikisaki
    Denpyo_Copy
    Sort_No
    MsgBox "完了しました。"
End Sub
Public Sub Denpyo_Sakujo() '「伝票削除」ボタンに割り当て
    Sheet_Sakujo
    MsgBox "削除しました。"
End Sub
Private Sub Denpyo_Copy()
    Sheet_Sakujo
    Dim wsFm As Worksheet
    Dim wsTo As Worksheet
    Dim st As String
    Dim lnFm As Long
    Dim lnFmMx As Long
    Dim lnTo As Long
    Dim dt As Date
    
    Set wsFm = Worksheets("main")
    lnFmMx = wsFm.Range("B" & Rows.Count).End(xlUp).Row
            
    For lnFm = 2 To lnFmMx
        If st <> wsFm.Range("B" & lnFm).Value Then
            If lnFm > 2 Then
                keisen
            End If
            st = wsFm.Range("B" & lnFm).Value
            Sheets("main1").Copy After:=Sheets(2)
            Set wsTo = Worksheets("main1 (2)")
            wsTo.Name = st
            lnTo = 16
        End If
        
        dt = wsFm.Range("C" & lnFm).Value
        wsTo.Range("B" & lnTo).Value = Format(dt, "yy")
        wsTo.Range("C" & lnTo).Value = Format(dt, "mm")
        wsTo.Range("D" & lnTo).Value = Format(dt, "dd")
        
        wsTo.Range("E" & lnTo).Value = wsFm.Range("D" & lnFm).Value
        wsTo.Range("F" & lnTo).Value = wsFm.Range("E" & lnFm).Value
        wsTo.Range("H" & lnTo).Value = wsFm.Range("F" & lnFm).Value
        
        If wsFm.Range("G" & lnFm).Value > 0 Then
            wsTo.Range("I" & lnTo).Value = wsFm.Range("G" & lnFm).Value
        Else
            wsTo.Range("J" & lnTo).Value = wsFm.Range("G" & lnFm).Value
        End If
        
        If lnTo = 16 Then
            wsTo.Range("K" & lnTo).Value = wsFm.Range("G" & lnFm).Value
        Else
            wsTo.Range("K" & lnTo).Value = wsTo.Range("K" & lnTo - 1).Value + wsFm.Range("G" & lnFm).Value
        End If
        lnTo = lnTo + 1
    Next
    keisen
    wsFm.Activate
End Sub

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

Private Sub No_Saiban()
    Dim ln As Long
    Dim lnMx As Long
    lnMx = Range("B" & Rows.Count).End(xlUp).Row
    Range("A1").Value = "No."
    For ln = 2 To lnMx
        Range("A" & ln).Value = ln
    Next
End Sub

Private Sub Sort_Torihikisaki()
    ActiveWorkbook.Worksheets("main").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("main").Sort.SortFields.Add _
        Key:=Range("B2:B317"), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("main").Sort
        .SetRange Range("A1:G317")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Private Sub Sort_No()
    ActiveWorkbook.Worksheets("main").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("main").Sort.SortFields.Add _
        Key:=Range("A2:A317"), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("main").Sort
        .SetRange Range("A1:G317")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("A1").Select
End Sub

Private Sub keisen()
    Dim lnMx As Long
    lnMx = Range("B" & Rows.Count).End(xlUp).Row
    With Range("B16:K" & lnMx + 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 = xlHairline
        End With
    End With
End Sub