Option Explicit
Dim Mn As Worksheet
Dim Mn1 As Worksheet
Dim Amax As Long
 
Sub Denpyo_making()
    Set Mn = Worksheets("main")
    Set Mn1 = Worksheets("main1")
    Amax = Mn.Range("B65536").End(xlUp).Row
    
    Deletesheets1
    Numbering
    Narabikae
    sheets_making
    Narabikae2
    syuseiH_C
End Sub
'プロシージャ名最後に1がつくのはなぜ？
Sub Deletesheets1()
    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
'シンプルでよいですね。
'このくらい短いと､ Denpyo_making に含めてもいいかも。
Sub Numbering()
    Mn.Range("A2").Value = 1
    Mn.Range("A2").AutoFill _
        Mn.Range("A2:A" & Amax), xlFillSeries
End Sub
Sub Narabikae()
    Mn.Sort.SortFields.Clear
    Mn.Sort.SortFields.Add Key:= _
        Range("B1"), Order:=xlAscending
    With Mn.Sort
        .SetRange Range("A1:G" & Amax)
        .Header = xlYes
        .Apply
    End With
End Sub
Sub sheets_making()
    Dim Namae As String
    Dim gyo As Long
    Dim Nws As Worksheet
    Dim dt As Date '日付
    Dim saki As Long
    
    For gyo = 2 To Amax
        If Namae <> Mn.Range("B" & gyo).Value Then
            If gyo > 2 Then
                keisen_making '最初だけ罫線回避
            End If
            Namae = Mn.Range("B" & gyo).Value
            Sheets("main1").Copy After:=Sheets(Sheets.Count)
            Sheets("main1 (2)").Select
            Sheets("main1 (2)").Name = Namae
            Set Nws = Worksheets(Namae)
            saki = 16
        End If
        dt = Mn.Range("C" & gyo).Value
        '↓以下の3つ、format関数を使った表現も研究してください。
        Nws.Range("B" & saki).Value = Right(Year(dt), 2)
        Nws.Range("C" & saki).Value = Month(dt)
        Nws.Range("D" & saki).Value = Day(dt)
        Nws.Range("F2").Value = Mn.Range("B" & gyo).Value
        Nws.Range("E" & saki).Value = Mn.Range("D" & gyo).Value
        Nws.Range("F" & saki).Value = Mn.Range("E" & gyo).Value
        Nws.Range("H" & saki).Value = Mn.Range("F" & gyo).Value
        
        If Mn.Range("G" & gyo).Value > 0 Then
            Nws.Range("I" & saki).Value = Mn.Range("G" & gyo).Value
        Else
            Nws.Range("J" & saki).Value = Mn.Range("G" & gyo).Value
        End If
        Nws.Range("K" & saki).Value = Nws.Range("I" & saki).Value + Nws.Range("J" & saki).Value
        saki = saki + 1
    Next
    keisen_making '最後の会社のシートに罫線つける
End Sub
 Sub keisen_making()
    Dim cNewmax
    cNewmax = Range("B65536").End(xlUp).Row
    'select, selectionを以下から除けますか。本編の自動記録について解説しているところで復習を！
    Range("B16:K" & cNewmax).Select
'    Range("B16:K" & Range("B65536").End(xlUp).Row).Select'←この書き方なら、変数宣言も不要になりますね。
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub
Sub Narabikae2()
    Mn.Sort.SortFields.Clear
    Mn.Sort.SortFields.Add Key:= _
        Range("C1"), Order:=xlAscending
    With Mn.Sort
        '↓これだと、並べ替え対象は3行目以降になってしまいますが。。動作確認OKでしょうか？
        .SetRange Range("A2:G" & Amax)
        .Header = xlYes
        .Apply
    End With
    '↓以下もよいかも。
    Range("A2:A" & Amax).ClearContents
    Mn.Range("A2").Value = ""
    Mn.Range("A2").AutoFill _
        Mn.Range("A2:A" & Amax), xlFillSeries
    
End Sub
'↓テンプレのほうをあらかじめいじっておけばこのプロセスまるまる不要
Sub syuseiH_C()
    Dim cNewmax As Long
    Dim c As Long
    Dim Wh As Worksheet
    cNewmax = Range("B65536").End(xlUp).Row
    
    For Each Wh In Worksheets
        If Left(Wh.Name, 4) <> "main" Then
            With Wh.PageSetup
                .LeftHeader = Wh.Name
                .RightHeader = "&D"
                .Zoom = 100
                .PrintErrors = xlPrintErrorsDisplayed
                .OddAndEvenPagesHeaderFooter = False
                .DifferentFirstPageHeaderFooter = False
                .ScaleWithDocHeaderFooter = True
                .AlignMarginsHeaderFooter = False
            End With
            ActiveSheet.PageSetup.PrintArea = "A1:K" & cNewmax
        End If
    Next
End Sub