Option Explicit
Sub CreateDenpyo()
    DeleteSheets
    CreateDenpyoExe
End Sub

Sub DeleteSheets()
    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

Sub CreateDenpyoExe()
'連想配列を使って、伝票作成のコードを書きました。
    
    Dim dic As New Scripting.Dictionary 'index=取引先名称、Item=転記先シートでの行数とする連想配列。
    Dim c As Long                       'Worksheets("main")の行数カウンター
    Dim cMx As Long                     'Worksheets("main")の最終行数
    Dim dt As Long                      'Worksheets("main")C列の日付
    Dim st As String                    'Worksheets("main")B列の取引先名称
    Dim w As Worksheet                  'Worksheets("main")のニックネーム
    
    Set w = Worksheets("main")
    cMx = w.Range("a65536").End(xlUp).Row
    
    For c = 2 To cMx
        st = w.Range("B" & c).Value
        If dic.Exists(st) = True Then
            dic.Item(st) = dic.Item(st) + 1
        Else
            dic.Add st, 16
            CreateSheets st
        End If
        
        InputData st, c, dic.Item(st)
    Next
    
    Dim vkey As Variant
    vkey = dic.Keys
    For c = LBound(vkey) To UBound(vkey)
        If Left(vkey(c), 4) <> "main" Then
            Keisen vkey(c), dic.Item(vkey(c))
        End If
    Next
    w.Select
    Range("a1").Select
End Sub

Sub CreateSheets(st As String)
    Worksheets("main1").Copy after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = st
End Sub

Sub InputData(st As String, cFm As Long, cTo As Long)
    Dim dt As Date
    Dim wTo As Worksheet
    Dim wFm As Worksheet
    Dim cKingaku
    Set wTo = Worksheets(st)
    Set wFm = Worksheets("main")
    
    dt = wFm.Range("c" & cFm).Value
    wTo.Range("b" & cTo).Value = Right(Year(dt), 2)
    wTo.Range("c" & cTo).Value = Month(dt)
    wTo.Range("d" & cTo).Value = Day(dt)
    wTo.Range("e" & cTo).Value = wFm.Range("d" & cFm).Value
    wTo.Range("f" & cTo).Value = wFm.Range("e" & cFm).Value
    wTo.Range("h" & cTo).Value = wFm.Range("f" & cFm).Value
    
    cKingaku = wFm.Range("g" & cFm).Value
    If cKingaku >= 0 Then
        wTo.Range("i" & cTo).Value = cKingaku
    Else
        wTo.Range("j" & cTo).Value = cKingaku
    End If
    
    If cTo = 16 Then
        wTo.Range("k" & cTo).Value = cKingaku
    Else
        wTo.Range("k" & cTo).Value = wTo.Range("k" & cTo - 1).Value + cKingaku
    End If

End Sub

Sub Keisen(st As Variant, c As Long)
'
' 罫線を引く
    Worksheets(st).Select
    With Range("B16:K" & c + 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