結合セルの値を異なるシートの結合セルにコピーするには?

Question 98.1   Previous Next
突然のご連絡に大変恐縮と存じます。サイトにて貴方様がマクロに精通されていることを知り、 現在抱えるマクロ作成についての疑問をクリアできるものと思い、メールさせて頂いた次第でございます。
もしお時間が頂けるようでしたら以下の条件の場合についてご意見頂きたくお願い申し上げます。

マクロで実行したい内容は、 Sheet1のK行に1~7の数値を入力したとき、L10,S10の範囲をSheet2の指定範囲にそれぞれコピーされるようにしたいです。
例えば、L10,S10ならK10に入力し、 L12,S12ならK12に入力するようにしたいです。
このとき、sheet2の貼り付け先の複数のセルにまたがって結合されている場合、 うまく貼り付けできません。この問題を解決する方法はございますでしょうか。
また、コピーする側が同じく複数のセルにまたがって結合されている場合も うまく動きません。この場合、セルの結合をはずす以外に対処できる方法がありましたら教えて頂きたくお願い申し上げます。
以下、参考のマクロです。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iTargetRaw As Integer
  If (Left(Target.Address, 3) = "$K$") And (CInt(Mid(Target.Address, 4) Mod 2) _
    = 0) And IsNumeric(Target.Value) Then
    If (1 <= CInt(Target.Value)) And (CInt(Target.Value) <= 7) Then
      iTargetRaw = CInt(Mid(Target.Address, 4))
      Sheet2.Range("B" & CStr(CInt(Target.Value) + 13)) = _
        Range("L" & CStr(iTargetRaw))
      Sheet2.Range("C" & CStr(CInt(Target.Value) + 13)) = _
        Range("S" & CStr(iTargetRaw))
    End If
  End If
End Sub

Answer   Copyright (C) 2009.9.10 永井善王
あなたのお目には止まらなかったようですが、質問の仕方 のページでご案内のとおり質問窓口は3つ設けておりまして、E-mailでのご質問はお断りしています。
ましてや、事前の了承も得ず、いきなりファイルを添付されましたが、『知らない人からの添付ファイルが付いたメールはウィルスメールかも』という世間の常識に倣って、私も、即削除する場合があります。
今後はご留意くださいませ。

あなたは既に、結合セルがあるとコピー貼り付けが上手くいかない場合があることをご存知で、参考として示されたマクロはCopyメソッドを使わずに、値の代入で行っています。

シート名…Sheet1 (オブジェクト名…Sheet3)
Sheet1 左図は、添付ファイルにあるシート名が「Sheet1」の一部です。 コピーしたいセル範囲を分かりやすくするため私が色付けしました。
参考として示されたマクロは、このシートのコード画面にあります。
まず始めは、
ピンク色の「L10結合」となっている結合セルの内容 (値) を、

シート名…Sheet2 (オブジェクト名…Sheet1)
Sheet2 シート名が「Sheet2」のピンク色で示した結合セルにコピーするのですが、結合状態がまったく異なります。
 Sheet1 … 2行6列からなる結合セル (L10:R11)
 Sheet2 … 1行5列からなる結合セル (B14:F14)

Sheet2 そのため、マクロの7行目のコードはイコール記号を使った代入文にしてあります。
この手法なら上手く行くはずですが、ちなみに、Sheet1の K10セルに「1」を入力して[Enter]キーを押すと、エラーになってしまいます。

エラーの原因は、エラーメッセージに表示されたとおり、結合セルだからではありません。 オブジェクトをきちんと定義してあげれば解決できるはずですから、7行目のコードを下記のどちらかの方法で修正しましょう。

シートをオブジェクト名で指定する方法
Sheet1.Range("B" & CStr(CInt(Target.Value) + 13)) = Range("L" & CStr(iTargetRaw))

シートをシート名で指定する方法
Worksheets("Sheet2").Range("B" & CStr(CInt(Target.Value) + 13)) = Range("L" & CStr(iTargetRaw))

8行目のコードも同様に修正してから試してみて、上手く行ったらご連絡ください。

【参考】
ワークシート名を変更するとマクロを書き換えないといけないか?

 

Excel VBA Macro