[[20240719171527]]　『セル番地をコピーしたい』（福寿）　ページの最後に飛ぶ

『セル番地をコピーしたい』（福寿）

シート１の色を付けたセルのセル番地をシート２に書き出すには下記コードをどのように変更したらよいか教えてください。
Copyの前に.addressを付けてみましたがオブジェクトが必要です。とエラーになりなすすべがわかりません。

Sub main()
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim i As Long
Dim j As Long
Dim Q As Long
Q = 2
Set Sh1 = Sheets(Sheet1)
Set Sh2 = Sheets("Sheet2")

'セルをループ」してクリーム色だったら、Sheet2へ転記
For j = 1 To 3

    For i = 1 To 16
        If Sh1.Cells(i, j).Interior.Color = RGB(255, 242, 204) Then
           Sh1.Cells(i, j).Copy Sh2.Cells(Q, 1)
           Q = Q + 1
        End If
    Next i
Next j
Set Sh1 = Nothing
Set Sh2 = Nothing
End Sub

＜使用 Excel：Microsoft365、使用 OS：Windows10 ＞

 >Sh1.Cells(i, j).Copy Sh2.Cells(Q, 1)

 セル番地を転記する場合は、

 Sh2.Cells(Q, 1).Value = Sh1.Cells(i, j).Address(0,0)

 のようにします。
（OK） 2024/07/19(金) 17:58:04

 参考まで。

https://www.sejuku.net/blog/72244
（OK） 2024/07/19(金) 18:00:39

OKさん　できました。ありがとうございます。
しかし書き出したセル番号がやけに多いので色付けされたセルをよく見たら、
結合されていることが判明しました。
折角教えていただいたのに。。。また違う問題にぶつかりました。
結合セルの左上のセルだけ書き出すことなんてできたりしますでしょうか。
ご存じでしたら教えてください。

（福寿） 2024/07/19(金) 18:20:29

 If sh1.Cells(i, j).MergeArea(1).Address = sh1.Cells(i, j).Address Then
 という条件を追加して限定すればいいですね。
（xyz） 2024/07/19(金) 18:42:09

xyzさん　すすごい！
あったんですね　MergeAreaなるものが
ありがとうございます。

（福寿） 2024/07/19(金) 19:20:45

コメント返信：

[ 一覧(最新更新順) ]

[[20240719171527]] 『セル番地をコピーしたい』（福寿） ページの最後に飛ぶ

[[20240719171527]]　『セル番地をコピーしたい』（福寿）　ページの最後に飛ぶ