実行時エラー１００４：結合セルの転記について

Question

###前提・実現したいこと
転記作業をVBAで行っておりまして、（https://teratail.com/questions/108653）、
以前教えていただいて（https://teratail.com/questions/104639）結合セルは、margeareaでコードを入れてみたところ、うまく転記が実行されず、下記のエラーが出てくるようになってしまいます。

この操作は複数の選択範囲については機能しません
実行時エラー1004

下記のように変更してみたりしましたが、
sagyoCell.Copy
というところが黄色くはいらいとされ、実行がとまってしまいます。

他に、どう試行錯誤してみたらよいか、ヒントをいただけますと幸いです。
よろしくお願いします。

###該当のソースコード

            '作業内容～金額'を開いている転記元からコピーして転記先にペースト
           Set pasteCell = pasteWs.Cells(iPasteRow, "D")

            Dim sagyoCell As Excel.Range
                Set sagyoCell = Union(copyWs.Range("B37").MergeArea, copyWs.Range("M78").MergeArea)

            
            sagyoCell.Copy
            pasteCell.PasteSpecial Paste:=xlPasteValues, _
                           Operation:=xlNone, _
                           SkipBlanks:=False, _
                           Transpose:=False
 

※転記元のエクセルシートでは、B37からH37までが１個のセルに結合されています。

下記は、アドバイスをいただいてから試してみたソースコードと
まだ行き詰っていることです。

試したソース

 Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "D").End(xlUp).Offset(0, 0)
    
    Dim sagyokingakuCell As Excel.Range
    With copyWs
        Set sagyokingakuCell = _
                .Range( _
                    .Range("B37"), _
                    .Range("B37").End(xlToRight).End(xlDown) _
                )
 
    End With 'copyWs


    'sagyokingakuCell.Copy
    'pasteCell.PasteSpecial Paste:=xlPasteValues, _
    '                       Operation:=xlNone, _
    '                       SkipBlanks:=False, _
    '                       Transpose:=False
    pasteCell.Value() = sagyokingakuCell.Value()

行き詰っていること
複数行転記したいが、画像の黄色セルしか転記されない。

Answer 1

前の質問
VBA - マクロ実行時に、クリップボードの確認で止まるのを防ぎたい(108697)｜teratail
でも回答しましたが、Copy PasteSpecial で転記するのは推奨しません。
単純に代入操作で転記しましょう。

また、結合セルの値は先頭セルに格納されているので、値の転記だけなら、.MergeArea は不必要です。

さらに、Union を使うのも、コードが読みづらくなるのでやめたいですね。

上記の点を考慮すれば、下記の２行ですみます。

    pasteWs.Cells(iPasteRow, "D").Value = copyWs.Range("B37").Value
    pasteWs.Cells(iPasteRow, "O").Value = copyWs.Range("M78").Value

シンプルだし、読みやすいと思いませんか。
また、クリップボードの確認に煩わらさせられることもないです。

追記

セル範囲の代入のコード例
B37 から、M列の最後までのセル範囲をコピー

    Dim pasteCell As Excel.Range
    Dim sagyokingakuCell As Excel.Range
    
    With copyWs
        Set sagyokingakuCell = _
                .Range( _
                    .Range("B37"), _
                    .Cells(.Rows.Count, "M").End(xlUp) _
                )
    End With 'copyWs
      
    With pasteWs
        Set pasteCell = .Cells(.Rows.Count, "D").End(xlUp).Offset(1, 0) _
                    .Resize(sagyokingakuCell.Rows.Count, sagyokingakuCell.Columns.Count)
    End With 'pasteWS
    pasteCell.Value = sagyokingakuCell.Value

Resizeで代入元と代入先のセル範囲サイズを揃えてます。
セル結合していると、先頭セルのみに値があり、他は空欄になりますので、
.End(xlToRight).End(xlDown)では、想定の範囲が取得できるとは限らないので、
十分確認してください。

Comments

[退会済みユーザー]

早速のわかりやすいアドバイス誠にありがとうございました！
お礼が遅く大変恐縮です。

ソースコードを編集しなおしていろいろためしたのですが、
複数行にわたって転記されるところが一行の途中までしか転記できずにおります。

わかりやすくヒントをいただいたのに自力でまだ解決できず大変恐縮ですが、
アドバイスを何卒いま一度いただけますと幸いです。

よろしくお願いいたします。

[退会済みユーザー]

質問文を編集して、下のほうに現在最後に試したソースコードなどを追記しました。
お力添えいただければ幸いです。どうぞよろしくお願いいたします。

[hatena19]

代入されるセル範囲が、1セル分しかないからです。
代入する場合は、代入する側と代入される側のセル範囲のサイズが同じでないとだめです。
コード例を追記しておきました。

[退会済みユーザー]

早速のアドバイス誠にありがとうございます！
そのような意味だったのですね！エラーの内容がやっと理解できました。
恐れ入ります、コード例の追記はどこから拝見することできますでしょうか。。？？

[hatena19]

追記を書くのに時間がかかりました。いま、追記しましたので確認ください。

[退会済みユーザー]

失礼しました！追記ありがとうございます！！（高速でコード添削くださり、問い合わせ内容しっかり把握してくださるのとてもすごいです！！）

うまく実行処理されました！！！

今後も活用できるよう、Resizeも覚えておきます！！
ありがとうございました！また質問させていただいた際には、どうぞよろしくお願いいたします！！

Answer 2

sagyoCell.MergeArea.Copy ではダメでしょうか？

個人的には結合セルを多用するのは、
ケアする事が多いので非推奨です。