Sub dk()
a = "12345678901234"
b = Mid(a, 1, 11)
Range("a3") = b
Set c = Range("a1:a65356").Find(b, LookIn:=xlValues)
If Not c Is Nothing Then
Debug.Print c.Address
Do While True
d = InStr(2, c.Address, "$")
e = Mid(c.Address, d + 1)
If d > 1 Then Exit Do
Loop
Range("h" & e) = a
End If
End Sub