Try this!

Sub AAA()
Dim Cell_Value As Variant
Dim Cell_ColoIndex As Byte

Cell_Value = Sheets("Sht").Range("D2").Value
On Error Resume Next
With Sheets("sTL")
.Visible = True
.Activate
.Range("A1").Select
Cells.Find( _
What:=Cell_Value, _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False).Activate
End With
Cell_ColoIndex = ActiveCell.Interior.ColorIndex
'then apply this color index to you new sheet
End Su

--
Message posted from http://www.ExcelForum.com