取次の送品予定表を、使える資料に編集して保存するVBA

Option Explicit

Sub 送品表作成()
    Dim a As Integer
    Dim Prow As Long
    Dim t, x As Long
    Dim Va As String
    Dim Tax As Long

'コード①
        Worksheets("送品予定表").Activate
        With Worksheets("送品予定表")
            .Range("A:L").Font.Size = 10
            With .Range("A1:L1")
                .WrapText = True
                .Font.Bold = True
            End With
            With .Range("A1")
                .RowHeight = 21
                .Value = "No."
                .ColumnWidth = 4
            End With
            With .Range("B1")
                .Value = Worksheets("設定操作").Range("J4")
                .ColumnWidth = 8
            End With
            With .Range("C1")
                .Value = Worksheets("設定操作").Range("J5")
                .ColumnWidth = 9
            End With
            With .Range("D1")
                .Value = Worksheets("設定操作").Range("J6")
                .ColumnWidth = 8
            End With
            With Range("E1")
                .Value = Worksheets("設定操作").Range("J7")
                .ColumnWidth = 4
            End With
            With .Range("F1")
                .Value = Worksheets("設定操作").Range("J8")
                .ColumnWidth = 4
            End With
            With .Range("G1")
                .Value = Worksheets("設定操作").Range("J9")
                .ColumnWidth = 3
            End With
            With .Range("H1")
                .Value = Worksheets("設定操作").Range("J10")
                .ColumnWidth = 11
            End With
            With .Range("I1")
                .Value = Worksheets("設定操作").Range("J11")
                .ColumnWidth = 21
            End With
            With .Range("J1")
                .Value = Worksheets("設定操作").Range("J12")
                .ColumnWidth = 8
            End With
            With .Range("K1")
                .Value = Worksheets("設定操作").Range("J13")
                .ColumnWidth = 6
            End With
            With .Range("L1")
                .Value = "消費税"
                .ColumnWidth = 6
            End With
        End With

'コード②
        With Worksheets("設定操作")
            a = .Range("I5").Value
            Tax = .Range("G9").Value
        End With
        Prow = Worksheets("Ｐａｓｔｅ").Cells(Rows.Count, 1).End(xlUp).Row
        For t = 0 To 9
            Va = Worksheets("設定操作").Range("K" & 4 + t)
            Worksheets("Ｐａｓｔｅ").Select
            Range(Cells(1 + a, Va), Cells(Prow, Va)).Copy _
                    Destination:=Worksheets("送品予定表").Cells(2, 2 + t)
        Next t
        For x = 2 To Prow
        With Worksheets("送品予定表")
            .Range("A" & x) = x - 1
            .Range("L" & x).Value = Application.Round( _
                            .Range("K" & x).Value * (1 + Tax / 100), 0)
        End With
        Next x
        
        Application.CutCopyMode = False

'コード③
        Worksheets("送品予定表").Activate
        With Worksheets("送品予定表")
            .Range("A:L").Font.Size = 10
            With .Range("J:J")
                .Font.Size = 9
                .HorizontalAlignment = xlRight
            End With
            With .PageSetup
                .PrintTitleRows = "$1:$1"
                .PrintTitleColumns = ""
                .PrintArea = "A1:L" & Prow
                .CenterHeader = "雑誌新刊送品予定表"
                .RightHeader = "☆マークは配達候補、■マークは取置候補"
            End With
            With .Range(Cells(1, 1), Cells(Prow, 12))
                    With .Borders
                        .LineStyle = xlContinuous
                        .Weight = xlHairline
                    End With
            End With
            .Range("A1").Select
        End With
        Worksheets("Ｐａｓｔｅ").Select
        Range("A1").Select
        Worksheets("設定操作").Select
        Range("E1").Select
        MsgBox "作成が終了しました。", vbInformation, "送品予定表作成"
End Sub

Sub 送品表BUP()
    Dim mypath As String
    Dim FN As String
        With Worksheets("送品予定表")
            .Activate
            .Cells.Copy
            .Range("A1").Select
            FN = .Range("B2")
        End With
        ChDir ThisWorkbook.Path & "\雑誌送品"
        Workbooks.Add
        ActiveSheet.Paste
        ActiveWorkbook.SaveAs Filename:="雑誌送品" & FN & ".xlsx"
        Range("A1").Select
        ActiveWorkbook.Close
        Worksheets("送品予定表").Select
        Range("A1").Select
End Sub

Sub 送品表クリアー()
        Worksheets("送品予定表").Select
        With Cells
            .ClearContents
            .UseStandardHeight = True
            .UseStandardWidth = True
            .ClearFormats
        End With
        Range("A1").Select
        With Worksheets("送品予定表").PageSetup
            .PrintArea = ""
            .PrintTitleRows = False
        End With
        Worksheets("設定操作").Select
        Range("E1").Select
End Sub

Sub Pasteシートクリアー()
        Worksheets("Ｐａｓｔｅ").Select
        With Cells
            .ClearContents
            .UseStandardHeight = True
            .UseStandardWidth = True
            .ClearFormats
        End With
        Range("A1").Select
        Worksheets("設定操作").Select
        Range("E1").Select
End Sub