ExcelVBAである範囲のセルの値と背景色を取得したい

Question

###前提・実現したいこと
ExcelVBAでfind関数を使って、見つかったセルとその横にあるセルの値を配列で取得し別シートに張り付ける際に、そのセルの背景色も取得して貼り付けたいと思っています。

###発生している問題・エラーメッセージ
セルの値は配列で取得でき、別シートに張り付けることができたのですが
`そのセルの背景色の取得と張り付け方が全然わかりません。
よろしくお願いします。
###該当のソースコード

VBA
Sub Depomanage()
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    Dim FoundCell As Range, FirstCell As Range, Target As Range
    Dim cnt As Long
    Dim kensaku As String
    Dim a(700) As Range     
    Dim iFind As Integer    

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
        Set ws1 = Worksheets("test")
        Set ws2 = Worksheets("test1")
        Set ws3 = Worksheets("test2")

    iFind = 0
            
    For cnt = 2 To ws1.Cells(Rows.Count, "A").End(xlUp).Row
    
    DoEvents

    kensaku = ws1.Cells(cnt, 1).Value
    ws2.Select

        Set FoundCell = ws2.Columns("D:D").Find(What:=kensaku, SearchFormat:=True)
        If FoundCell Is Nothing Then
            '見つからなかった処理
            ws1.Cells(cnt, 1).Interior.ColorIndex = 3
            ws1.Cells(cnt, 1).Offset(0, 3) = 0
            GoTo YES_TASK
        Else
            Set FirstCell = FoundCell
            '見つかった処理
            ws1.Cells(cnt, 1).Interior.ColorIndex = 6
        End If
        Do
            Set FoundCell = Cells.FindNext(FoundCell)
            If FoundCell.Address = FirstCell.Address Then
                Set a(iFind) = Range(FoundCell.Offset(0, -3), FoundCell.Offset(0, 2))
                FoundCell.Offset(0, 7) = 1
                iFind = iFind + 1
               
        Exit Do
            Else
            '重複処理
            ws1.Cells(cnt, 1).Interior.ColorIndex = 4
            ws1.Cells(cnt, 1).Offset(0, 3) = 2

            End If
        Loop
YES_TASK:
        Next cnt
'見つかったセルを別シートに...背景色がない

For i = 0 To 700
 If a(i) Is Nothing Then Exit For   
 Line = ws3.Cells(Rows.Count, "A").End(xlUp).Row
 ws3.Select
 Range(Cells(Line + 1, "A"), Cells(Line + 1, "F")).Value2 = a(i).Value2  
        
Next

 Application.EnableEvents = True
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True
End Sub

###試したこと
findで見つかったセルをcopyして張り付けてみたのですが
処理に時間がかかってしまうため、断念しました。

###補足情報(言語/FW/ツール等のバージョンなど)
Excel 2013

Answer 1

Cell の背景色の指定は「Cells().Interior.Color」または「Cells().Interior.ColorIndex」で設定します。
背景色の設定

上記を踏まえて、見つかったセルを別シートにコピーする際、色設定は ws1 から取る必要があるように思えます。

その為、値のコピーのあと、以下の通り処理を加えます。
意図した塗りつぶしかわかりませんが、コピペ先のレンジ（A-F列）に、ws1 で割り当てられた色で色分けします。

' 変数宣言追加
Dim i As Long
Dim Line As Long

For i = 0 To 700
 If a(i) Is Nothing Then Exit For
 Line = ws3.Cells(Rows.Count, "A").End(xlUp).Row
 ws3.Select
 Range(Cells(i + 1, "A"), Cells(i + 1, "F")).Value2 = a(i).Value2

 '' ws1 の色設定をアクティブなワークシートのレンジに指定。
 Range(Cells(i + 1, "A"), Cells(i + 1, "F")).Interior.ColorIndex = ws1.Cells(a(i).Row, 1).Interior.ColorIndex

Next

余談ですが、オブジェクトの指定が曖昧だったり、そもそも変数の宣言がないところが気になりました。
VBA では、このあたりがバグの温床になりやすいので、リファクタリングしてみてください。

Comments

[退会済みユーザー]

ご回答ありがとうございます。
具体的なコードの記述までしていただき、大変助かりました。
オブジェクトの指定や変数の宣言の部分も今後気をつけてやっていきます。

ベストアンサーに選ばせていただきます。
ありがとうございました。

Answer 2

質問のコードだと、セルの値(Value)を変更しているだけなので、背景色などが変わりません。

見つかったセル( FoundCell )の背景色なら、 FoundCell.Interior.Color で取得できます。

  Dim origColor as Variant
 origColor = FoundCell.Interior.Color

というような感じで、見つかったセルの背景色の値を取得しておいて

  Dim destination as Range
  distination.Interior.Color = origColor

のようにして、貼り付け先(distination)の背景色を見つかったセルの背景色にすれば、希望されている事が出来るように思われます。

Comments

[退会済みユーザー]

ご回答ありがとうございます。
こちらの曖昧な質問に対して、コード記述も含めて、ご回答ありがとうございました。

とても勉強になりました。

Answer 3

背景色はInterior.ColorIndexとInterior.Colorで定義されているので、これらをコピーしてあげれば良いかと思います。
ただし、Rangeで複数範囲にたいしては処理できないので、１セルずつ処理してあげる必要があります。

Comments

[退会済みユーザー]

ご回答ありがとうございます。
Interior.ColorIndexとInterior.Colorを初めて知りました。

ありがとうございます。