ub createhyperlink()
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim rng As Range
Dim c As Range
Dim rng2 As Range
Set ws = Sheets("Sheet1")
Set ws1 = Sheets("Sheet2")
Set rng = ws1.Range("a2:A" & ws1.Cells(Cells.Rows.Count, "A").End(xlUp).Row)
For Each c In rng
If c.Value <> "" Then
x = c.Value
Set rng2 = ws.Columns(1).Find(What:=x, after:=ws.Cells(1), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not rng2 Is Nothing Then ws.Hyperlinks.Add Anchor:=c, Address:="", SubAddress:="" & ws.Name & "!" & rng2.Address(0, 0) & "", TextToDisplay:=c.Value
End If
Next c
End Sub
|