Option Explicit
'**************************************************************************************
'まず機能を分けよう
'[1]データをソートする機能
'※まずはAにNOを割り振る
'①取引先名称を名前順にする
'②その後､NOに置き換える
'[2] 取引先名称が変わるまで転記する処理を続ける
'①上の名前が違ったときは
'    新しいワークシートを作成
'    転記先のシートに情報を転記する
'    新しいシートにその行の情報を転記する
'    そしてループでまた判定に戻る
'② 上の名前と同じだったときは
'    新しいワークシートをつくる処理に移らずに
'    転記する処理を繰り返す
'
'[3] 転記を終えたら､最後に線を描く処理を行う
'    ※はじめの処理は行わない
'    [2] の①の最初に前のシートのところで
'    線を描く処理をはさむ
'    その後に新しいワークシートの処理へ進む
'
'[4] そして最後にボタンを作成して終了
'**************************************************************************************
'まとめ
Sub Main() '最初に確認です。伝票作成ボタンを押すと怒られませんか？僕は怒られました。モジュール名main、プロシージャ名mainでかぶっているからではないか？と。 ogawa
    '↓分かりやすいですね！ ogawa
    Call NoTuika
    Call Sort_Name
    Call Make_Ws
    Call Sort_No
End Sub
'**************************************************************************************
'シートの削除
'**************************************************************************************
Sub Delete_Sheet() '↑コメント秀逸です。（他も同様） ogawa
    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 Make_Ws()
    Call Delete_Sheet
'**************************************************
    Dim wsFm As Worksheet
    Dim wsTo As Worksheet
    Set wsFm = Worksheets("main")
    Dim cnt As Long
    Dim cGyo As Long
    Dim cLas As Long: cLas = wsFm.Range("B" & Rows.Count).End(xlUp).Row '←宣言と値設定を1行で済ませるアイデア、おもしろいです！ ogawa
'**************************************************
    For cnt = 2 To cLas
        '新しいシートを作成する処理↓
        If wsFm.Range("B" & cnt).Value <> wsFm.Range("B" & cnt - 1).Value Then
            '次の行への処理へ移る前に前のシートに線を描いていく
            If cnt > 2 Then
                Call Make_Line
            End If
            
            'ワークシートをさくせいして
            Sheets("main1").Copy , after:=Worksheets("main") '途中のカンマは不要(結果的に動きますが) ogawa
            Set wsTo = ActiveSheet
            wsTo.Name = wsFm.Range("B" & cnt).Value
            wsTo.Range("F2").Value = wsTo.Name
            '転記先の行数をリセット
            cGyo = 16
        End If
        '新しいシート作成後、転記する処理↓
            '作成済みのワークシートに転記
            '↓[1] [2]までインデントひとつ多すぎでした (^^; ogawa
            '取引内容
            wsTo.Range("H" & cGyo).Value = wsFm.Range("F" & cnt).Value
            '会計番号
            wsTo.Range("E" & cGyo).Value = wsFm.Range("D" & cnt).Value
            '伝票番号
            wsTo.Range("F" & cGyo).Value = wsFm.Range("E" & cnt).Value
            
            '取引金額の分岐
            If wsFm.Range("G" & cnt).Value > 0 Then
                '借方金額
                wsTo.Range("I" & cGyo).Value = wsFm.Range("G" & cnt).Value
            Else
                '貸方金額
                wsTo.Range("J" & cGyo).Value = wsFm.Range("G" & cnt).Value
            End If
            
            '日付記入
            Dim dt As Date: dt = wsFm.Range("C" & cGyo).Value 'この変数定義はForループに入るより前でしましょう ogawa
            '年
            wsTo.Range("B" & cGyo).Value = Right(Year(dt), 2)
            '月
            wsTo.Range("C" & cGyo).Value = Month(dt)
            '年
            wsTo.Range("D" & cGyo).Value = Day(dt)
            'K列に入れる「残高」が...(^^; ogawa
            '次の転記行を定数として足す
            cGyo = cGyo + 1
    Next '[2]この手前までインデントひとつ多すぎでした (^^; ogawa
    '最後のシートにも線を描く処理を施す
    Call Make_Line

End Sub

'**************************************************************************************
'線を書く処理
'**************************************************************************************
Sub Make_Line() '↓withの使い方、とてもよくできています (^^* ogawa
    Dim Aws As Worksheet: Set Aws = ActiveSheet
    Dim cLas As Long: cLas = Aws.Range("H" & Rows.Count).End(xlUp).Row
    With Aws.Range("B16:K" & cLas + 1)
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
        End With
    End With
    
End Sub
'**************************************************************************************
'データの順序を処理
'**************************************************************************************
Sub NoTuika()

    Dim cGyo As Long
    Dim cLas As Long
    Dim wsFm As Worksheet: Set wsFm = Worksheets("main")
    cLas = wsFm.Range("B" & Rows.Count).End(xlUp).Row
    
    Dim c As Long '↓autofillを使う値投入方法も研究してみてください！ ogawa
    wsFm.Range("A1").Value = "No."
    For c = 2 To cLas
        Range("A" & c).Value = c - 1
    Next
    
        
End Sub

Sub Sort_Name()
     'データ件数が316件でない場合も動くマクロになるように修正しましょう ogawa
     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
        .Apply
    End With

End Sub

Sub Sort_No()
     'データ件数が316件でない場合も動くマクロになるように修正しましょう ogawa
     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
        .Apply
    End With

End Sub
'**************************************************************************************

Option Explicit
'小川別解をところどころ入れます
Sub Main_ogawa()
    '画面の更新を止める(20%程度高速化すると言われています)。ありとなしとでのパフォーマンスを比較してみてください。
    Application.ScreenUpdating = False
    Call NoTuika_ogawa
    Call Sort_Name_ogawa
    Call Make_Ws_ogawa
    Call Sort_No_ogawa
    Application.ScreenUpdating = True
End Sub
Sub Delete_Sheet_ogawa()
    Dim ws As Worksheet
    Application.DisplayAlerts = False
    For Each ws In Worksheets
        If Not Left(ws.Name, 4) = "main" Then 'notで書いてみた
            ws.Delete
        End If
    Next
    Application.DisplayAlerts = True
End Sub
Sub Make_Ws_ogawa()
    Call Delete_Sheet_ogawa
    
    Dim wsFm As Worksheet: Set wsFm = Worksheets("main") '1行にまとめる
    Dim wsTo As Worksheet
    Dim cnt As Long
    Dim cGyo As Long
    Dim cLas As Long: cLas = wsFm.Range("B" & Rows.Count).End(xlUp).Row
    Dim dt As Date 'ここでなくループの中で変数宣言すると、ループの回数だけ変数を宣言しなおすことになります。非効率 ogawa
    For cnt = 2 To cLas
        If wsFm.Range("B" & cnt).Value <> wsFm.Range("B" & cnt - 1).Value Then
            If cnt > 2 Then
                Call Make_Line_ogawa
            End If
            Sheets("main1").Copy after:=wsFm 'シートの指定の書き方を変更
            Set wsTo = ActiveSheet
            wsTo.Name = wsFm.Range("B" & cnt).Value
            wsTo.Range("F2").Value = wsTo.Name
            cGyo = 16
        End If
        With wsTo 'withでまとめてみた
            .Range("H" & cGyo).Value = wsFm.Range("F" & cnt).Value
            .Range("E" & cGyo).Value = wsFm.Range("D" & cnt).Value
            .Range("F" & cGyo).Value = wsFm.Range("E" & cnt).Value
            If wsFm.Range("G" & cnt).Value > 0 Then
                .Range("I" & cGyo).Value = wsFm.Range("G" & cnt).Value
            Else
                .Range("J" & cGyo).Value = wsFm.Range("G" & cnt).Value
            End If
            'K列への入力、やってみましょう！
            dt = wsFm.Range("C" & cGyo).Value
            .Range("B" & cGyo).Value = Format(dt, "yy") 'Format関数
            .Range("C" & cGyo).Value = Format(dt, "mm") 'Format関数
            .Range("D" & cGyo).Value = Format(dt, "dd") 'Format関数
        End With
        cGyo = cGyo + 1
    Next
    Call Make_Line_ogawa
End Sub

Sub Make_Line_ogawa()
    Dim Aws As Worksheet: Set Aws = ActiveSheet
    Dim cLas As Long: cLas = Aws.Range("H" & Rows.Count).End(xlUp).Row
    With Aws.Range("B16:K" & cLas + 1)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous 'それぞれwith内で1度しか登場しなかったので、withブロックは解除
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
    
End Sub
Sub NoTuika_ogawa()

    Dim wsFm As Worksheet: Set wsFm = Worksheets("main")
    Dim cGyo As Long
    Dim cLas As Long: cLas = wsFm.Range("B" & Rows.Count).End(xlUp).Row 'この順序ならここもこのタイミングで１行で書ける
    
    Dim c As Long
    wsFm.Range("A1").Value = "No."
    For c = 2 To cLas
        Range("A" & c).Value = c - 1
    Next
End Sub

'↓sort_name, sort_no はkeyになる列が異なるだけ。
'  なので、１つのプロシージャだけで、モジュールレベル変数を使って使い回せるようにも書けます。
'  (発展編2レベルのノウハウを使うなら、モジュールレベル変数ではなく、引数つきプロシージャで)
'  あとは、 Range("A1:G317") の代わりに currentregion を使うとか。(ワークシートを適切に指定しないとバグりますが)
Sub Sort_Name_ogawa()
    With Worksheets("main").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("B2:B317"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A1:G317")
        .Header = xlYes
        .Apply
    End With
End Sub

Sub Sort_No_ogawa()
    With Worksheets("main").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A2:A317"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A1:G317")
        .Header = xlYes
        .Apply
    End With
End Sub