Sub devilkurs()
    Dim Arr(), Arr2(), iR%, iR2%, sURL As String, Sh, Sh2
    Set Sh = ThisWorkbook.Sheets("Лист1")
    Set Sh2 = Sheets("Лист2")
    Arr = Sh.Range(Sh.Cells(2, 1), Sh.Cells(Sh.Cells(Sh.Rows.Count, 2).End(xlUp).Row, 2)).Value
    Arr2 = Sh2.Range(Sh2.Cells(2, 1), Sh2.Cells(Sh2.Cells(Sh2.Rows.Count, 2).End(xlUp).Row, 2)).Value
    
    For iR2 = 2 To UBound(Arr2, 1) + 1
        For iR = 2 To UBound(Arr, 1) + 1
            If Arr2(iR2 - 1, 2) = Arr(iR - 1, 2) Then
                If Sh.Cells(iR, 1).Hyperlinks.Count > 0 Then
                sURL = Sh.Cells(iR, 1).Hyperlinks(1).Address
                Sh2.Hyperlinks.Add Anchor:=Sh2.Cells(iR2, 1), Address:= _
                    sURL, TextToDisplay:=Sh.Cells(iR2, 1).Value
                End If
            End If
        Next
    Next
    
End Sub

Sub addHyperlinks()
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim i As Long, r As Long, link As String, lr As Long
    Set sh1 = ThisWorkbook.Sheets(1)
    Set sh2 = ThisWorkbook.Sheets(2)
    With sh2
        lr = .Cells(Rows.Count, 1).End(xlUp).Row
        .Cells(3, 1).Resize(lr - 2).Hyperlinks.Delete
        On Error Resume Next
        For i = 3 To lr
            r = 0
            r = WorksheetFunction.Match(.Cells(i, 2), sh1.Columns("b:b"), 0)
            If r Then
                link = sh1.Cells(r, 1).Hyperlinks(1).Address
                .Cells(i, 1).Hyperlinks.Add Anchor:=.Cells(i, 1), Address:=link
            End If
        Next i
    End With
End Sub