Option Explicit

'以下の２行、インデントはしません。 ogawa
    Dim moto As Long    '転記元行番号
    Dim saki As Long    '転記先行番号
    
Sub main()  'メインの実行プロシージャ
    '↓プロシージャ名、どれもわかりやすくていいですね！ ogawa
    Delete_Voucher
    num_asg
    name_sort
    Create_Voucher
    num_sort
End Sub

Sub Delete_Voucher() 'シート削除用("main","mai1"を除く)
    
    Dim w As Worksheet
    
    For Each w In Worksheets
        Select Case w.Name
            '↓以下、よいですね (^^ ogawa
            Case "main", "main1"
            Case Else
                Application.DisplayAlerts = False
                w.Delete
                Application.DisplayAlerts = True
        End Select
    Next
End Sub

Sub num_asg()   'Noの割り振り

    Worksheets("main").Select
    Range("A1").Value = "No"
    
    Dim LastNum As Long
    LastNum = Range("B" & Rows.Count).End(xlUp).Row
    
    'autofillで値を入れる方法も調べて実装してみてください ogawa
    Dim gyo As Long
    For gyo = 2 To LastNum
        Range("A" & gyo) = gyo - 1
    Next
End Sub

Sub name_sort()     '名称で並べ替え

    Worksheets("main").Select
    Columns("A:G").Select '←不要 ogawa
    '↓以下、 good! です (^^* ogawa
    ActiveWorkbook.Worksheets("main").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("main").Sort.SortFields.Add _
                                    Key:=Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row), _
                                    SortOn:=xlSortOnValues, _
                                    Order:=xlAscending, _
                                    DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("main").Sort
        .SetRange Range("A1:G" & Range("G" & Rows.Count).End(xlUp).Row)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Sub Create_Voucher() 'シート作成用
    
    Dim LastNum As Long
        LastNum = Range("B" & Rows.Count).End(xlUp).Row '←インデントおおすぎです ogawa
    Dim name_bk As String
    Dim shFm As Worksheet
    Set shFm = Worksheets("main")
    saki = 16 '[*1]
    
    For moto = 2 To LastNum
                                    
        If (moto = 2) Or (name_bk <> shFm.Range("B" & moto).Value) Then '←カッコなくても同じ条件文になります。 or が一番弱い演算子なので。とはいえ、今の段階では、こういう書き方を保険的にすることはとても良いと思います (^^* ogawa
            If moto <> 2 Then
                Call keisen                                              '取引先名称が異なった時に、罫線を作成し
                '↓この saki=16 を if 文のあとに持っていけば、[*1]は不要だったかと。 ogawa
                saki = 16                                                '転送先の行番号を初期化する
            End If
            name_bk = shFm.Range("B" & moto).Value                       '最初の行読み込み時、もしくは、取引先名称が異なった時に、シートを作成する
            Worksheets("main1").Copy After:=Worksheets(Worksheets.Count)
            Worksheets(Worksheets.Count).Name = name_bk
        End If
        
        '以下の tenki, kingaku は、同じプロシージャにまとめたほうが良いかな、とも思います。やること似ていますし ogawa
        Call tenki
        Call kingaku
        saki = saki + 1
        
        '↓興味深い条件分岐ですね。
        '  ただし、for next構文のすべてでこの判断をされる、と考えると効率的には...。
        '  たとえば、元データが10万行あったとしたら、このスルーされるたけの条件判断が10万回されるわけです。
        '  ということで、僕ならfor nextの直後に最後の処理をすることにし、ここではif文は入れません。 ogawa
        If moto = LastNum Then
            Call keisen                                                  '最終行書込み後、罫線を引く
        End If
    Next
End Sub

Sub kingaku() 'お金の記載

    Dim shFm As Worksheet
    Set shFm = Worksheets("main")
    
    If shFm.Range("G" & moto).Value > 0 Then          '貸方・借方の転記
        Worksheets(Worksheets.Count).Range("I" & saki).Value = shFm.Range("G" & moto).Value
    Else
        Worksheets(Worksheets.Count).Range("J" & saki).Value = shFm.Range("G" & moto).Value
    End If
    
    If saki = 16 Then                                 '残高の記載
        Worksheets(Worksheets.Count).Range("K" & saki).Value = shFm.Range("G" & moto).Value
    Else
        Worksheets(Worksheets.Count).Range("K" & saki).Value = Worksheets(Worksheets.Count).Range("K" & saki - 1).Value + shFm.Range("G" & moto).Value
    End If
    
End Sub

Sub tenki()  'データの転記

    Dim shFm As Worksheet
    Set shFm = Worksheets("main")

    '↓最初の３行は、投入する値を format 関数で生成することも検討してください。 ogawa
    Worksheets(Worksheets.Count).Range("B" & saki).Value = Right(Year(shFm.Range("C" & moto).Value), 2)
    Worksheets(Worksheets.Count).Range("C" & saki).Value = Month(shFm.Range("C" & moto).Value)
    Worksheets(Worksheets.Count).Range("D" & saki).Value = Day(shFm.Range("C" & moto).Value)
    Worksheets(Worksheets.Count).Range("E" & saki).Value = shFm.Range("D" & moto).Value
    Worksheets(Worksheets.Count).Range("F" & saki).Value = shFm.Range("E" & moto).Value
    Worksheets(Worksheets.Count).Range("H" & saki).Value = shFm.Range("F" & moto).Value
End Sub

Sub keisen()  '罫線作成
    'とてもシンプルなコードになるところまで見事に昇華されましたね。すごい!! v(^^*
    'select, selection という言葉が登場しないようにリライトしてください。
    Range("B16").CurrentRegion.Select
    With Selection.Borders(xlEdgeLeft)
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .Weight = xlThin
    End With
End Sub

Sub num_sort()     'Noで並べ替え

    Worksheets("main").Select
    Columns("A:G").Select
    ActiveWorkbook.Worksheets("main").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("main").Sort.SortFields.Add _
                                    Key:=Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row), _
                                    SortOn:=xlSortOnValues, _
                                    Order:=xlAscending, _
                                    DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("main").Sort
        .SetRange Range("A1:G" & Range("G" & Rows.Count).End(xlUp).Row)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub