Jim Rech wrote:

Sub Test()
Dim FoundCell As Range
On Error Resume Next
Set FoundCell = Range("B:B").Find(Range("D1").Value)
If Not FoundCell Is Nothing Then
FoundCell.Offset(0, 1).Copy Range("F1")
End If
End Sub



Thanks

it's easy but it's works

Reiner