Buscador con macros en excel

Dante

Anteriormente me apoyo con un código para modificar una macro que tenia para buscar datos en otras hojas de un libro de excel, ahora solicito su ayuda nuevamente, en la base de datos tengo el control de unas facturas y están con hipervínculo, necesito que al utilizar el buscador los resultados también tengan activo el hipervínculo este es el código que tengo, espero y me pueda ayudar

Sub buscar()

    Dim WS As Worksheet

    Dim rBingo As Range

    Borrar_Form

    For Each WS In ThisWorkbook.Worksheets

        If WS.Name Like "Dir*" Then

            Set rBingo = WS.Cells.Find(what:=[Codigo], lookat:=xlWhole)

            If Not rBingo Is Nothing Then Exit For

   End If

    Next WS

    If rBingo Is Nothing Then

        ' Factura no encontrada

        MsgBox "Código " & [Codigo] & " factura no encontrada", vbInformation, "AM Consultores"

    Else

        Copiar_datos WS, rBingo.Row

     End If

    End Sub

Sub Borrar_Form()

    Dim rCell As Range

    Set rCell = [Datos]

    Do While rCell <> ""

        rCell.Offset(0, 1).Value = ""

        Set rCell = rCell.Offset(1, 0)

    Loop

    [Nota].Value = ""

End Sub

Sub Copiar_datos(ByRef queWS As Worksheet, ByVal queFila As Long)

    Dim rCell As Range

    Set rCell = [Datos]

    On Error Resume Next

    Do While rCell <> ""

        rCell.Offset(0, 1) = queWS.Cells(queFila, queWS.Rows(1).Find(rCell.Value).Column)

        Set rCell = rCell.Offset(1, 0)

    Loop

    On Error GoTo 0

    [Nota].Value = "El dato está en la hoja " & queWS.Name & ", en la fila " & Format(queFila, "#,##0")

    [Nota].Offset(0, 1) = queWS.Name & "," & queFila

End Sub

Sub Actualizar()

'Por.Dante Amor

    coma = InStr(1, [Nota].Offset(0, 1), ",")

    If coma > 0 Then

        hoja = Left([Nota].Offset(0, 1), coma - 1)

        fila = Val(Mid([Nota].Offset(0, 1), coma + 1))

    End If

    '

    Set rCell = [Datos]

    c = 2

    Do While rCell <> ""

        Sheets(hoja).Cells(fila, c) = rCell.Offset(0, 1)

        Set rCell = rCell.Offset(1, 0)

        c = c + 1

    Loop

End Sub