sub link()
'On Error GoTo thoat
Dim Rng1 As Range
With Sheets("2007").Range(Sheets("2007").[A2], Sheets("2007").[A100].End(xlUp))
For i = 33 To 1625
Set Rng1 = .Find(what:=Right(Sheet4.Range("H" & i), 14), LookIn:=xlFormulas, lookat:=xlWhole)
If Not Rng1 Is Nothing Then
Sheet4.Range("H" & i).Hyperlinks.add Anchor:=Sheet4.Range("H" & i), Address:="", SubAddress:= _
"'" & "2007" & "'" & "!A" & Rng1.Row, TextToDisplay:="2007_" & Rng1.Value
End If
Next
End With
'thoat:
End Sub