| 
    
     |  | こんな感じかな ? 
 Sub Test()
 Dim Sh1 As Worksheet, Sh2 As Worksheet
 Dim C As Range, FR As Range
 Dim Ad As String
 
 Set Sh1 = Worksheets("Sheet1")
 Set Sh2 = Worksheets("Sheet2")
 For Each C In Sh1.Range("B1", Sh1.Range("B65536").End(xlUp))
 If C.Interior.ColorIndex = xlColorIndexNone Then GoTo NLine
 Set FR = Sh2.Range("C:C").Find(C.Value, , xlValues)
 If FR Is Nothing Then GoTo NLine
 Ad = FR.Address
 Do
 Set FR = Sh2.Range("C:C").FindNext(FR)
 FR.Interior.ColorIndex = C.Interior.ColorIndex
 Loop Until FR.Address = Ad
 Set FR = Nothing
 NLine:
 Next
 Set Sh1 = Nothing: Set Sh2 = Nothing
 End Sub
 
 
 |  |