ブック間で転記したいが定義のエラーが発生してしまう

前提・実現したいこと

色々調べてみたのですが、独学で勉強を始めたばかりで答えが見つからなかったのでよろしくお願いします。

VBAで日次データのブックから月次データのブックに転記して、指定したセルが入力されていたらその下に、そこも入力されていたらさらに下に……となるようにしたいです。

一応の補足ですが、転記先をひとつだけ指定しているのは、次の月に移ったら前月分はシートごとコピーして別にして、”当月分”をまた使うため最初の転記先は固定したいからです。

このコードに至るまで散々エラーを出したので他にもおかしい箇所があるかもしれませんが、何が何やらわからず苦戦しております。質問箇所以外にエラーのもとがあるようでしたら、ご教授頂ければ幸いです。

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

IF文で指定したセルが空白ならそのまま貼り付け、そうでないならその下のセルに貼り付け……というのをやってみたのですが、定義がうまくできてないようで……
下記コードの10行目「Workbooks("利用者統計用.xlsm").Sheets("当月").Range("necopy").PasteSpecial Paste:=xlPasteValues」に「アプリケーション定義またはオブジェクト定義のエラー」が発生してしまいます。

該当のソースコード

Sub 統計コピー()
Dim tocopy, necopy As Long
    tocopy = Workbooks("利用者統計用.xlsm").Sheets("当月").Range("B4")  'コピー先を変数宣言
    necopy = Cells(Rows.Count, "B").End(xlUp).Row + 1
    If tocopy = "" Then                                       '空白であればそのまま貼り付け
        Workbooks("日次利用者.xlsm").Sheets("Sheet1").Range("A17:P17").Copy
        Workbooks("利用者統計用.xlsm").Sheets("当月").Range("B4").PasteSpecial Paste:=xlPasteValues  '別ブックへ値のみ貼り付け
        Application.CutCopyMode = False  'セル範囲選択状態を解除
    Else                                                                '入力済みならその下へ貼り付け指示
        Workbooks("日次利用者.xlsm").Sheets("Sheet1").Range("A17:P17").Copy
        Workbooks("利用者統計用.xlsm").Sheets("当月").Range("necopy").PasteSpecial Paste:=xlPasteValues  '別ブックへ値のみ貼り付け 
        Application.CutCopyMode = False  'セル範囲選択状態を解除
    
    
    End If
End Sub

試したこと

定義エラーだったので変数がいけないのかと思い、変数なしでやってみましたが当然ながらダメでした。
特にIF構文に拘りがあるわけではないのですが、勉強中でほかにどの構文が適しているかわかりません。

改めてよろしくお願いします。

kenshirou

2020/10/07 05:33 編集

"利用者統計用.xlsm"の"当月"シートには、"necopy"という名前の付いたセル範囲が存在していますか？

t.kk

2020/10/07 05:44

セルに名前は付けていません。解決にあたりせっかく質問して頂いたところ恐縮ですが、別の方の案を試したら解決しました！気にかけていただきありがとうございました。また機会がございましたらよろしくお願い致します。

行動規範の内容に同意します

回答1件

ベストアンサー

コード全体は見てませんが、とりあえずエラーの部分は下記に修正すれば、エラーはでなくなるはず。

vba
1Workbooks("利用者統計用.xlsm").Sheets("当月").Range("B" & necopy).PasteSpecial Paste:=xlPasteValues

解決しましたが、一応解説しておきます。

necopy = Cells(Rows.Count, "B").End(xlUp).Row + 1
で変数 necopy にB列の最終行の次の空白行の行番号を代入してます。

ここは、
necopy = Workbooks("利用者統計用.xlsm").Sheets("当月").Cells(Workbooks("利用者統計用.xlsm").Sheets("当月").Rows.Count, "B").End(xlUp).Row + 1
というようにブックとシートを省略せずに記述した方がいいです。
省略するとアクティブシートが対象になりますので、目的のシートかアクティブの時はいいですが、何かの拍子にアクティブシートが変わったりするとエラーになったり想定外のところにコピーされたりする可能性があります。

Workbooks("利用者統計用.xlsm").Sheets("当月").Range("necopy").PasteSpecial Paste:=xlPasteValues
の"necopy"というように引用符で囲んでしまうと単なる「necopy」という文字列になります。そこでエクセルは「necopy」という名前のついたセルを探しますが見つからないのでエラーを出します。

necopy には行番号が格納されていて、貼り付けたいセルは B列のnecopy行目(20行目と仮定)のセルとということですので、
"B" & necopy で B20 というような文字列になりセルを参照することができるようになります。

さらに追記。
ブックとシートを省略せずに記述するとコードが長くなって読みづらくなるというデメリットがあります。
一回限りなら With を使うと読みやすく記述できます。

vba
1    With Workbooks("利用者統計用.xlsm").Sheets("当月")
2        necopy = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
3   End with

そのシートが何度も登場するなら、変数に代入しておいて、それを使うといいです。

自分が書くなら下記のような感じになります。

vba
1Sub 統計コピー()
2    Dim fromRng As Range
3    Set fromRng = Workbooks("日次利用者.xlsm").Sheets("Sheet1").Range("A17:P17") 'コピー元セル範囲
4    
5    Dim toCopyWs As Worksheet
6    Set toCopyWs = Workbooks("利用者統計用.xlsm").Sheets("当月") 'コピー先シート
7        
8    Dim toCopyRng As Range
9    Set toCopyRng = toCopyWs.Range("B4") 'コピー先セル
10    
11    fromRng.Copy
12    If toCopyRng.Value = "" Then                                 '空白であればそのまま貼り付け
13        toCopyRng.PasteSpecial Paste:=xlPasteValues
14    Else                                                         '入力済みならその下へ貼り付け指示
15        Set toCopyRng = toCopyWs.Cells(toCopyWs.Rows.Count, "B").End(xlUp).Offset(1) '最終行のセル
16        Set toCopyRng = toCopyRng.Offset(1) '最終行セルの下
17        toCopyRng.PasteSpecial Paste:=xlPasteValues
18    End If
19    
20    Application.CutCopyMode = False  'セル範囲選択状態を解除
21
22End Sub