And I did make this work for me.

But I prefer isabell and Garry's shorter ones.

Thanks to both of you.

Regards,
Howard

For Each c In ActiveSheet.Range("B10", ActiveSheet.Range("B10").End(xlToRight))
If c = FiMo Then
c.Offset(7, 0).Resize(1, 2).Copy
Sheets("Sheet1").Range("A7").PasteSpecial Paste:=xlPasteValues
Exit Sub
End If
Next