質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

90.87%

  • VBA

    1555questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

実行時エラー1004:結合セルの転記について

解決済

回答 2

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 587
退会済みユーザー

退会済みユーザー

前提・実現したいこと

転記作業を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までが1個のセルに結合されています。

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

試したソース

 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()


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

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 2

checkベストアンサー

+1

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

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

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

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

    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)では、想定の範囲が取得できるとは限らないので、
十分確認してください。

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/01/19 12:27

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

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

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

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

    キャンセル

  • 2018/01/19 12:33

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

    キャンセル

  • 2018/01/19 14:32

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

    キャンセル

  • 2018/01/19 14:48

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

    キャンセル

  • 2018/01/19 15:06

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

    キャンセル

  • 2018/01/19 15:44

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

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

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

    キャンセル

+1

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

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

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 90.87%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る

  • VBA

    1555questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。