取次の発売予定データを加工して使える送品予定表を独自に作成する。

Sub 送品表作成()

Worksheets("送品予定表").Select
'コード①
Range("A:L").Font.Size = 9
Range("A:A").ColumnWidth = 4
Range("B:B").ColumnWidth = 8
Range("C:C").ColumnWidth = 10
Range("D:D").ColumnWidth = 8
Range("E:F").ColumnWidth = 4
Range("G:G").ColumnWidth = 3
Range("H:H").ColumnWidth = 11
Range("I:I").ColumnWidth = 21
Range("J:J").ColumnWidth = 7
Range("K:K").ColumnWidth = 6
Range("L:L").ColumnWidth = 6

Range("A1").RowHeight = 21

Range("A1") = "No."
Range("B1") = Worksheets("設定操作").Range("J4")
Range("C1") = Worksheets("設定操作").Range("J5")
Range("D1") = Worksheets("設定操作").Range("J6")
Range("E1") = Worksheets("設定操作").Range("J7")
Range("F1") = Worksheets("設定操作").Range("J8")
Range("G1") = Worksheets("設定操作").Range("J9")
Range("H1") = Worksheets("設定操作").Range("J10")
Range("I1") = Worksheets("設定操作").Range("J11")
Range("J1") = Worksheets("設定操作").Range("J12")
Range("K1") = Worksheets("設定操作").Range("J13")
Range("L1") = "消費税"
With Range("A1:L1")
.WrapText = True
.Font.Bold = True
End With
'コード①ここまで

End Sub

「外商定期購読雑誌リスト」と「店頭お取り置き予約雑誌リスト」を参照して、
その発売時に注意喚起としてチェックマークを表示するようにもできます。これについては、また改めて別記事で紹介させていただきます。

Dim a As Integer
Dim Prow As Long
Dim t As Long, x As Long
Dim tax As Long

Worksheets("設定操作").Select
a = Range("I5")
tax = Range("G9")

Worksheets("Ｐａｓｔｅ").Select
Prow = Cells(Rows.Count, 1).End(xlUp).Row

    Worksheets("設定操作").Select
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)

    Worksheets("設定操作").Select
Next t
    Worksheets("送品予定表").Select
For x = 2 To Prow

    Range("A" & x) = x - 1
    Range("L" & x).Value = Application.Round(Range("K" & x).Value * (1 + tax / 100), 0)

Next x

Application.CutCopyMode = False

Worksheets("送品予定表").Range("A:L").Font.Size = 10
With ActiveSheet.PageSetup
    .PrintTitleRows = "$1:$1"
    .PrintTitleColumns = ""
    .PrintArea = "A1:L" & Prow
    .CenterHeader = "雑誌新刊送品予定表"
    .RightHeader = "☆マークは配達候補、■マークは取置候補"
End With

Range(Cells(1, 1), Cells(Prow, 12)).Select
With Selection.Borders
    .LineStyle = xlContinuous
    .Weight = xlHairline
End With
Range("A1").Select

Worksheets("Ｐａｓｔｅ").Select
Range("A1").Select
Worksheets("設定操作").Select
Range("E1").Select

MsgBox "作成が終了しました。"

End Sub

Sub 送品表BUP()

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

End Sub

Sub 送品表クリアー()

Worksheets("送品予定表").Select
Cells.Select
With Selection
    .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
Cells.Select
With Selection
    .ClearContents
    .UseStandardHeight = True
    .UseStandardWidth = True
    .ClearFormats
End With
Range("A1").Select
Worksheets("設定操作").Select
Range("E1").Select

End Sub

今回のプランに加えて、

• 「外商定期購読雑誌リスト」
• 「店頭お取り置き予約雑誌リスト」

と、さらにデータ連携させることで、

「きょうの発売雑誌の配達や取り置きはあったかな？」

と何度もリストを見返す手間や、人的な配達ミスを減らすことができるようになると思います。

このプランは改めて記事で紹介していく予定です。しばらくお待ちください。