Copiar Celda con Hipervínculo Microsoft Excel VBA

Necesito crear un buscador con Macros (VBA Excel), el cual me permita ingresar un "TAG" en una celda, y me entregue la información de todos los atributos que contenga dicho "TAG" basado en una lista de datos. Cabe destacar que la búsqueda se realiza en todas las Hojas de Cálculo que contenga el Libro, dado a que los "TAG" están clasificados en ellas.

Realicé el código siguiente en VBA el cual me es útil y me entrega la información según el "TAG" ingresado, pero uno de los atributos ("Layout") es un hipervínculo, el cual lamentablemente sólo me lo copia como texto, y no como hipervínculo. Lo que más necesito es que me entregue en la Hoja (Buscar) el hipervínculo.

El código que realicé es el siguiente, agradezco vuestra ayuda.

VBA Hoja 1 (Buscar)

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect([Codigo], Target) Is Nothing Then Exit Sub
    If Not [bAuto] Then Exit Sub
    Buscar
End Sub

VBA Módulo 1

Option Explicit
Sub Buscar()
    Dim WS As Worksheet
    Dim rBingo As Range
    Borrar_Form
    For Each WS In ThisWorkbook.Worksheets
        If WS.Name Like "FZ*" 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
        ' No encontrado
        MsgBox "Código " & [Codigo] & " no encontrado", 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")
End Sub

Esta es la planilla, no la pude adjuntar:

Añade tu respuesta

Haz clic para o