Book間のコピーペースト

Question

前提・実現したいこと

ブックA(別ブック）の値をブックBにコピーして請求書を作成しようとしています。

追記
ブックABの構成としては
ブックA:簡単に項目毎に分けた請求費用（シートは4枚有）
ブックB:請求書雛形、取引会社の情報等が入ってくるのでシート数は不定

発生している問題・エラーメッセージ

インデックスが有効範囲にありません。

オブジェクトは、このプロパティまたはメソッドをサポートしていません。

該当のソースコード

Sub demo()

    '鏡を開く
    Workbooks.Open "C:\Users\xxxxxxxxx\Desktop\請求書データベース.xls"

    '請求書雛形bookをアクティブに
    Workbooks("請求書雛形.xlsm").Activate
    
    
    Dim num, i, j, k, m, n As Variant
    
    '青色シートの削除※
    Application.DisplayAlerts = False
        For num = worksheets.Count To 1 Step -1
            If worksheets(num).Tab.ColorIndex = 5 Then
                worksheets(num).Delete
            End If
        Next
    Application.DisplayAlerts = True

    
    For i = worksheets.Count To 2 Step -1
        If worksheets(i).Name = "雛形" Then
        Exit For

        ElseIf worksheets(i).Name <> "雛形" Then
                                
                '入力
                Sheets("雛形").Range("AA1").Value = Format(Now, "yyyy年m月d日")
                Sheets("雛形").Range("A4") = worksheets(worksheets.Count).Range("B2")
                Sheets("雛形").Range("B1") = worksheets(worksheets.Count).Range("B3")
                Sheets("雛形").Range("B2") = worksheets(worksheets.Count).Range("B4")
                Sheets("雛形").Range("V13") = worksheets(worksheets.Count).Range("B8")
                Sheets("雛形").Range("Z13") = worksheets(worksheets.Count).Range("B9")
                Sheets("雛形").Range("S13") = worksheets(worksheets.Count).Range("B10")
                
                
                '書式整える
                Range("A4,B1,B2,V13,Z13").VerticalAlignment = xlCenter
                
                'セルの結合
                Sheets("雛形").Range("AA1:AE1").Merge
                Sheets("雛形").Range("V13:X14").Merge
                Sheets("雛形").Range("Z13:AA14").Merge
                Sheets("雛形").Range("S13:S14").Merge
                
        
                '入力されたものを別シートとして出力
                worksheets("雛形").Copy after:=worksheets("雛形")
                
                '上記出力したシートの名前とシートの色を変更
                Sheets("雛形 (2)").Name = Range("A4") & "請求書"
                ActiveSheet.Tab.ColorIndex = 5
                
                '雛形再構築
                Sheets("雛形").Range("AA1:AE1").UnMerge
                Sheets("雛形").Range("V13:X14").UnMerge
                Sheets("雛形").Range("Z13:AA14").UnMerge
                Sheets("雛形").Range("S13:S14").UnMerge
                
                worksheets("雛形").Range("A4,B1,B2").Clear
                worksheets("雛形").Range("AA1,V13,Z13").ClearContents
                Sheets(2).Select
                
                '入力完了した企業シートを削除
                Application.DisplayAlerts = False
                worksheets(worksheets.Count).Delete
                Application.DisplayAlerts = True
        End If
    Next
    
    'データベースから入力
    Dim R As Range
    Set R = Range("A4")

    For k = worksheets.Count To 1 Step -1
        If Workbooks("請求書雛形").worksheets(k).Tab.ColorIndex = 5 Then
            For m = 6 To Sheets("請求一覧").Cells(Rows.Count, 1).End(xlUp).Row + 1
                If Workbooks("請求書雛形.xlsm").worksheets(k).R = Workbooks("請求書データベース.xls").worksheets("請求一覧").Range("H" & m) Then
                    Workbooks("請求書雛形.xlsm").worksheets(k).Range("B17") = Workbooks("請求書データベース.xls").worksheets("請求一覧").Range("F" & m)
                End If
            Next m

        End If
    Next k
    
    'PDF出力　現状本エクセルがあるフォルダに出力PDFを保存するように
    Dim fileName As String
    x = ActiveSheet.Name
    
        For j = worksheets.Count To 1 Step -1
            If worksheets(j).Tab.ColorIndex = 5 Then
                worksheets(j).ExportAsFixedFormat Type:=xlTypePDF, _
                fileName:=ThisWorkbook.Path & "\" & _
                worksheets(j).Name, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, OpenAfterPublish:=True
            End If
        Next
    
End Sub

試したこと

book、sheetを変数に組み込もうとすると"メソッドをサポートしていません"の
エラーが出るので一旦解きました。

エラー自体は"データベースからの入力"の6行目から出ております。

補足情報（FW/ツールのバージョンなど）

Excel 2010

Comments

[DreamTheater]

人に調べてもらうなら、どの行でエラーが発生するとかブックAやB（特にブックA)がどんな構成なのかくらい書きましょう。
（シート数が何枚とか）

[退会済みユーザー]

大変失礼致しました。
ご指摘していただきました点を修正致しました。

引き続き宜しくお願い致します。

Answer 1

シートのレイアウトが不明なので細かく精査してませんが、
とりあえず「'データベースから入力」の部分を下記のように修正してください。

    'データベースから入力
    Dim R As String
    Set R = "A4"

    For k = Worksheets.Count To 1 Step -1
        If Workbooks("請求書雛形").Worksheets(k).Tab.ColorIndex = 5 Then
            For m = 6 To Sheets("請求一覧").Cells(Rows.Count, 1).End(xlUp).Row + 1
                If Workbooks("請求書雛形.xlsm").Worksheets(k).Range(R) = Workbooks("請求書データベース.xls").Worksheets("請求一覧").Range("H" & m) Then
                    Workbooks("請求書雛形.xlsm").Worksheets(k).Range("B17") = Workbooks("請求書データベース.xls").Worksheets("請求一覧").Range("F" & m)
                End If
            Next m

        End If
    Next k

解説

    Dim R As Range
    Set R = Range("A4")

という書き方は現在のアクティブブックのアクティブシートのA4セルという意味になります。
それを使って、
Workbooks("請求書雛形.xlsm").Worksheets(k).R
というような書き方はできません。
すでに、ブックもシートも決まっているのに重ねて指定することはできないということです。

Comments

[退会済みユーザー]

ご返答ありがとうございます。
上記修正させて頂きました！

私の記述したコードで"For m = 6 To Sheets("請求一覧").Cells(Rows.Count, 1).End(xlUp).Row + 1"でのエラーが出てしまいました。
こちらのコードもアクティブでないと作動しないのでしょうか。

[hatena19]

エラーメッセージはなんですか。
"請求一覧" というシートは現在アクティブなブックにありますか。

ブックやシートを省略する書き方=現在アクティブなブックを対象とする、というコーディングは読みづらいしバグの元になります。といっていちいちすべてにブック名とシート名をつけていてはコードが長くなりまた読みづらくなります。

ブックやシートを変数に代入してそれを利用するコーディングにすべきですね。

[退会済みユーザー]

ご返答ありがとうございます。

やはり変数への代入は必須ですよねぇ…
このプログラムで代入に対してエラーが出たのですが、再度チャレンジ致します！

ありがとうございました！

ありがとうございました。

Answer 2

ちゃんと全体は見ていませんが・・・

SetしたRはアクティブシートのものという情報がつくので、
何らかのシート名を指定しての利用はできません。（同じシートでも異なるシートでも）
そのままRange("A4")とすればいいのではないでしょうか。

If Workbooks("請求書雛形.xlsm").worksheets(k).Range("A4") = Workbooks("請求書データベース.xls").worksheets("請求一覧").Range("H" & m) Then

Comments

[hatena19]

同じシートでも使用できないですね。

[radames1000]

hatena19さん
表現が不適切でしたね。ご指摘ありがとうございます。