Option Explicit
'提出物では、よけいなモジュールはすべて削除しましょう。 ogawa
Sub CREATEDENPYO() 'エントリーのプログラムはあえてすべて大文字にする。。おもしろいですね！ ogawa
    NumberingTokuisaki
    ExeCreateDenpyo
    NarabiModosi
End Sub

'↓コメント秀逸です ogawa
Sub NumberingTokuisaki()  '---各取引明細にナンバーを付す

'sub ... end sub 内は一段インデントします。なので、以下の５行はインデント不足。他のプロシージャ内でも同様です ogawa
Dim shFm As Worksheet
Dim lnFm As Long
Dim lnFmMx As Long
Set shFm = Worksheets("main")
lnFmMx = shFm.Range("B" & Rows.Count).End(xlUp).Row
    shFm.Range("A1").Value = "No."
    'autofill を使う方法も研究してください ogawa
    For lnFm = 2 To lnFmMx
        shFm.Range("A" & lnFm).Value = lnFm - 1
        Debug.Print lnFm '←提出物では、出力の必要がない場合は削除 ogawa
    Next

    shFm.Range("A1:G" & lnFmMx).Select  '---取引先ごとに並び替え '←この行不要かも？いずれにせよ、 .select は極力なくなるように！ ogawa
    'with shFm.Sort. ... end with でさらに以下全体をまとめられますね。（というか、もっとまとめられますが） ogawa
    shFm.Sort.SortFields.Clear
    shFm.Sort.SortFields.Add Key:=Range("B2:B" & lnFmMx)
    With shFm.Sort
        .SetRange Range("A1:G" & lnFmMx)
        .Header = xlYes
        .Apply
    End With

End Sub
Sub NarabiModosi()

Dim shFm As Worksheet
Dim lnFmMx As Long
Set shFm = Worksheets("main")
lnFmMx = shFm.Range("B" & Rows.Count).End(xlUp).Row
    shFm.Activate
    shFm.Range("A1:G" & lnFmMx).Select  '---取引先ごとに並び替え
    shFm.Sort.SortFields.Clear
    shFm.Sort.SortFields.Add Key:=Range("A2:A" & lnFmMx)
    With shFm.Sort
        .SetRange Range("A1:G" & lnFmMx)
        .Header = xlYes
        .Apply
    End With

End Sub




Sub ExeCreateDenpyo()

ShToDelete

Dim shFm As Worksheet
Dim shTo As Worksheet
Dim lnFm As Long
Dim lnFmMx As Long
Dim lnTo As Long
Dim lnToMx As Long
Dim st As String
Dim dt As Date
Dim rg As Range
Set shFm = Worksheets("main")
Set shTo = Worksheets("main1")
lnFmMx = shFm.Range("B" & Rows.Count).End(xlUp).Row
    For lnFm = 2 To lnFmMx
        If shFm.Range("B" & lnFm) <> st Then '.Valueが抜けています。次の行も同様。 ogawa
            st = shFm.Range("B" & lnFm)
            
            '↓以下はおもしろい条件式ですね。お手本と比べての善悪を簡単に述べられません。お手本の方法でもやれるようにしましょう。 ogawa
            If shTo.Name <> "main1" Then
                lnToMx = shTo.Range("B" & Rows.Count).End(xlUp).Row
                Set rg = shTo.Range("B16:K" & lnToMx)
                With rg.Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                End With
                With rg.Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                End With
                With rg.Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                End With
                With rg.Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                End With
                With rg.Borders(xlInsideVertical)
                    .LineStyle = xlContinuous
                End With
                With rg.Borders(xlInsideHorizontal)
                    .LineStyle = xlContinuous
                End With
            End If
            
                        
            Worksheets("main1").Copy after:=shFm
            Set shTo = ActiveSheet
            shTo.Name = st  '---各取引先の元帳が完成
            lnTo = 16
        End If
            '---ここから日付の転記
        dt = shFm.Range("C" & lnFm).Value
        '↓format関数を使う方法も検討しましょう ogawa
        shTo.Range("B" & lnTo).Value = Right(Year(dt), 2)
        shTo.Range("C" & lnTo).Value = Month(dt)
        shTo.Range("D" & lnTo).Value = Day(dt)
        
        
            '---ここから会計番号、伝票番号、摘要、借方(貸方)金額の転記
        shTo.Range("E" & lnTo).Value = shFm.Range("D" & lnFm).Value
        shTo.Range("F" & lnTo).Value = shFm.Range("E" & lnFm).Value
        shTo.Range("H" & lnTo).Value = shFm.Range("F" & lnFm).Value
        '↓インデント余計です。 ogawa
            If shFm.Range("G" & lnFm).Value > 0 Then
                shTo.Range("I" & lnTo).Value = shFm.Range("G" & lnFm).Value
            Else
                shTo.Range("J" & lnTo).Value = shFm.Range("G" & lnFm).Value
            End If
            
            '---ここから残高の転記
            If lnTo <> 16 Then
                shTo.Range("K" & lnTo).Value = shTo.Range("K" & lnTo - 1).Value + _
                                                                    shFm.Range("G" & lnFm).Value
            Else
                shTo.Range("K" & lnTo).Value = shFm.Range("G" & lnFm).Value
            End If
        
        lnTo = lnTo + 1
    
    Next

    lnToMx = shTo.Range("B" & Rows.Count).End(xlUp).Row
    Set rg = shTo.Range("B16:K" & lnToMx)
    With rg
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With

'または､
'    With shTo.Range("B16:K" & lnToMx)
'        .Borders(xlEdgeLeft).LineStyle = xlContinuous
'        .Borders(xlEdgeTop).LineStyle = xlContinuous
'        .Borders(xlEdgeBottom).LineStyle = xlContinuous
'        .Borders(xlEdgeRight).LineStyle = xlContinuous
'        .Borders(xlInsideVertical).LineStyle = xlContinuous
'        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
'    End With

'    With rg.Borders(xlEdgeLeft)
'        .LineStyle = xlContinuous
'    End With
'    With rg.Borders(xlEdgeTop)
'        .LineStyle = xlContinuous
'    End With
'    With rg.Borders(xlEdgeBottom)
'        .LineStyle = xlContinuous
'    End With
'    With rg.Borders(xlEdgeRight)
'        .LineStyle = xlContinuous
'    End With
'    With rg.Borders(xlInsideVertical)
'        .LineStyle = xlContinuous
'    End With
'    With rg.Borders(xlInsideHorizontal)
'        .LineStyle = xlContinuous
'    End With


End Sub

Sub ShToDelete()  '---"main"以外のシートを削除する
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