Option Explicit
Dim wOg As Worksheet    '原本シート（main）の変数
Dim wDa As Worksheet    'データシート(main1)の変数
Dim cDaMxRow As Long    'データシート(main1)の最終行を示す変数
Dim cMkRow As Long      '新規シートの行を指定する変数
Dim Skey As String      'データシートの並び替えを指定する変数
    
Public Sub Homework()
    Set wOg = Worksheets("main1")
    Set wDa = Worksheets("main")
    cDaMxRow = wDa.Range("B" & Rows.Count).End(xlUp).Row
    
    DelDenpyou
    BangouFuri
    
    Skey = "B1"
    Narabikae

    CreateDenpyou

    Skey = "A1"
    Narabikae

    DeleteBangou
End Sub

Public Sub DelDenpyou()
    Dim Wsh As Worksheet
    Application.DisplayAlerts = False
    For Each Wsh In Worksheets
        With Wsh
            If .Name <> "main" And .Name <> "main1" Then  '←if文に変更
                .delete
            End If
        End With
    Next Wsh
    Application.DisplayAlerts = True
    PrintSet '[★]追加要件
End Sub

Sub PrintSet() '[★]追加要件
    If wOg.Name = "main" Then
        With wOg.PageSetup
            .LeftHeader = "&A"
            .CenterHeader = ""
            .RightHeader = ""
            .LeftFooter = ""
            .CenterFooter = ""
            .RightFooter = "[作成日]&D"
        End With
    Else
        With ActiveSheet.PageSetup
            .PrintArea = ""
            .FitToPagesWide = 1
            .FitToPagesTall = 1
        End With
    End If
End Sub

Public Sub BangouFuri()
    Dim cNt As Long
    With wDa.Range("A1")
        .Offset(0, 0).Value = "No."
        For cNt = 1 To 3
            .Offset(cNt, 0).Value = cNt
        Next cNt
    End With
    wDa.Range("A2:A4").AutoFill Destination:=wDa.Range("A2:A" & cDaMxRow)
End Sub

Public Sub CreateDenpyou()
    Dim wMk As Worksheet
    Dim cDaRow As Long
    Dim sClnt As String
    Dim dTda As Date
    For cDaRow = 2 To cDaMxRow
        If sClnt <> wDa.Range("B" & cDaRow).Value Then
            If cDaRow > 2 Then
                Keisen
                PrintSet '[★]追加要件
            End If
            wOg.Copy after:=Worksheets(Worksheets.Count)
            sClnt = wDa.Range("B" & cDaRow).Value
            Set wMk = ActiveSheet
            wMk.Name = sClnt
            cMkRow = 16
        End If
        dTda = wDa.Range("C" & cMkRow).Value
        With wMk
            .Range("B" & cMkRow).Value = Mid(Year(dTda), 3)
            .Range("C" & cMkRow).Value = Month(dTda)
            .Range("D" & cMkRow).Value = Day(dTda)
            .Range("E" & cMkRow).Value = wDa.Range("D" & cMkRow).Value
            .Range("F" & cMkRow).Value = wDa.Range("E" & cMkRow).Value
            .Range("H" & cMkRow).Value = wDa.Range("F" & cMkRow).Value
            If wDa.Range("G" & cMkRow).Value > 0 Then
                .Range("I" & cMkRow).Value = wDa.Range("G" & cMkRow).Value
            Else
                .Range("J" & cMkRow).Value = wDa.Range("G" & cMkRow).Value
            End If
            .Range("K" & cMkRow).Value = WorksheetFunction.Sum(.Range("I16:J" & cMkRow))
        End With
        cMkRow = cMkRow + 1
    Next cDaRow
    Keisen
End Sub

Public Sub Keisen()
    With Range("B16:K" & cMkRow)
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
    End With
End Sub

Public Sub Narabikae()
    With wDa
        With .Sort
            With .SortFields
                .Clear
                .Add Key:=wDa.Range(Skey), Order:=xlAscending
            End With
            .SetRange wDa.Range("A1:G" & cDaMxRow)
            .Header = xlYes
            .Apply
        End With
    End With
End Sub

Public Sub DeleteBangou()
    With wDa
        .Activate '←ここに記載し、1回のみの処理に変更
        .Range("A1").Activate
        .Range("A1").EntireColumn.ClearContents
    End With
End Sub