ブック間のデータ移動と編集 注文書からテンプレートへ

Option Explicit

Function wb() As Workbook
    Set wb = Workbooks("FAX注文書作成.xlsm")
End Function

Function wbT() As Workbook
    Set wbT = Workbooks("FAX注文書テンプレート.xlsm")
End Function

Function wsS() As Worksheet
    Set wsS = wb.Worksheets("出版社リスト")
End Function

Function wsHSD() As Worksheet
    Set wsHSD = wbT.Worksheets("発注資料表")
End Function

Sub 発注資料()
    Dim Hsheet As Worksheet
    Dim Ssheet As Worksheet
    Dim SPRow, VARow, HBRow As Long
    Dim VA, Hva, Fva, Iva As Variant
    Dim Bva, Jva, Gva, Nva As Variant
    Dim i, j, x, xx, y, t, tt As Long
    Dim w, ww, z, AR As Long
    Dim flag As Boolean
    Dim workb As Workbook
    Dim Fpa As String
        Fpa = ThisWorkbook.Path & "\FAX注文書テンプレート.xlsm"
'既にFAX注文書テンプレート.xlsmが開かれているかチェック
        flag = False
        For Each workb In Workbooks
            If workb.FullName = Fpa Then
                flag = True
                Exit For
            End If
        Next
        If flag = False Then
            Workbooks.Open Fpa
        End If
'発注先出版社数を調べる
        With wsS
            .Activate
            SPRow = .Cells(Rows.Count, 1).End(xlUp).Row
        End With
'出版社別シートから各注文書籍データを取り出す
        z = 1
        For i = 1 To SPRow
            VA = wsS.Range("A" & i).Value
            wb.Worksheets(VA).Activate
                VARow = Cells(Rows.Count, 1).End(xlUp).Row
                For j = 1 To VARow
                    With wb.Worksheets(VA)
                        .Activate
                        Hva = .Range("C" & j).Value
                        Fva = .Range("B" & j).Value
                        Iva = .Range("D" & j).Value
                        Bva = .Range("F" & j).Value
                        Jva = .Range("E" & j).Value
                        Gva = .Range("A" & j).Value
                        Nva = .Range("G" & j).Value
                    End With
'FAX注文書テンプレート.xlsmの発注資料表シートに書籍データを転記する
    'FAX注文書40ページ分の入力データ表を作成する
                    With wsHSD
                        .Activate
                        For t = 1 To 40
                            tt = t * 9 - 8
                            .Range("A" & tt) = "Ｐ" & t
                            .Range("A" & tt + 1) = "分類名"
                            .Range("B" & tt + 1) = "出版社名"
                            .Range("C" & tt + 1) = "書名"
                            .Range("D" & tt + 1) = "著者名"
                            .Range("E" & tt + 1) = "冊数"
                            .Range("F" & tt + 1) = "本体価格"
                            .Range("G" & tt + 1) = "シリーズ名"
                            .Range("H" & tt + 1) = "版数"
                            .Range("I" & tt + 1) = "送品条件"
                            .Range("J" & tt + 1) = "ＩＳＢＮコード"
                            .Range("K" & tt + 1) = "客注名"
                            .Range("M" & 1) = "この列文字記入禁止"
                            With .Range(.Cells(tt, 1), .Cells(tt + 1, 13))
                                    .Font.Bold = True
                                    .Interior.ColorIndex = 35
                            End With
                        Next t
'FAX注文書のページ切り替えに付いての設定を行なう
                        On Error Resume Next
                        AR = WorksheetFunction.Match("Ｐ" & z, _
                                                        .Columns("A"), 0)
                        If AR = 0 Then
                            MsgBox "発注資料表の作成でエラーが発生" & _
                                "しました。" & vbCrLf & "発注資料作成" & _
                                "を再度行なってください。", _
                                            vbExclamation, "FAX注文書作成"
                            Exit Sub
                        End If
                        On Error GoTo 0
    'ひとつの出版社への注文数で6品目以上は改ページが必要
                        x = j Mod 5
                        xx = j \ 5
                        If x = 0 Then xx = j \ 6
                           y = AR + 1 + j + 4 * xx
                    '出版社名
                                .Range("B" & y).Value = Hva
                    '書名
                                .Range("C" & y).Value = Fva
                    '著者名
                                .Range("D" & y).Value = Iva
                    '冊数
                                .Range("E" & y).Value = Bva
                    '本体価格
                                .Range("F" & y).Value = Jva
                    '表示設定
                                .Range("J:J").NumberFormatLocal = "0_ "
                    'ISBNコード
                                .Range("J" & y).Value = Gva
                    '客注名
                                .Range("K" & y).Value = Nva
    '入力マーキングで最終のデータ入力行を確認出来るようにする
                    '入力行マーキング
                                .Range("M" & y).Value = "○"
                    End With
                Next j
    '改ページを行なう時のデータ入力セル位置を計算する
            wsHSD.Activate
                HBRow = wsHSD.Cells(Rows.Count, 13).End(xlUp).Row
                w = HBRow Mod 9
                ww = HBRow \ 9
                If ww = 0 Then
                    If w < 3 Then
                        z = 1
                    Else
                        z = 2
                    End If
                Else
                    z = ww + 1 + 1
                End If
            wsS.Activate
        Next i
        With wsHSD
            .Activate
            .Columns("A:M").AutoFit
        End With
End Sub