Excel - Error al escribir los resultados

Buenas tarde.

tengo un problema con este código para Excel, el código es para buscar un valor en una tabla y que me escriba en una ventana los valores de la fila con el titulo pero cuando lo ejecuto el código encuentra el valor buscado pero el valor fila queda en 0 por lo tanto cuando comienza a escribir los datos de la fila todos quedan en blanco.

Sub BuscarYMostrarDatos()
Dim ValorBuscado As Variant
Dim RangoBuscar As Range
Dim CeldaEncontrada As Range
Dim FilaEncontrada As Range
Dim Titulos As Range
Dim Resultado As String
Dim i As Integer

' Solicita el valor a buscar
ValorBuscado = InputBox("Introduce el valor a buscar:")

' Define el rango donde buscar (J1:P18) en la hoja "Hoja1"
Set RangoBuscar = Sheets("Hoja1").Range("J1:P18")

' Busca el valor en el rango
Set CeldaEncontrada = RangoBuscar.Find(What:=ValorBuscado, LookIn:=xlValues, LookAt:=xlWhole)

If Not CeldaEncontrada Is Nothing Then
' Si se encuentra el valor, obtiene la fila completa
Set FilaEncontrada = CeldaEncontrada.EntireRow
' Obtiene los títulos de las columnas (J1:P1)
Set Titulos = Sheets("Hoja1").Range("J1:P1")

' Construye el resultado con los datos del registro encontrado
For i = 1 To Titulos.Columns.Count
Resultado = Resultado & Titulos.Cells(1, i).Value & ": " & FilaEncontrada.Cells(1, i).Value & vbNewLine
Next i

' Muestra el resultado en un cuadro de mensaje
MsgBox Resultado, vbInformation, "Datos del registro encontrado"
Else
' Si no se encuentra el valor, muestra un mensaje
MsgBox "El valor no se encontró en el rango.", vbExclamation, "Búsqueda"
End If
End Sub

Es necesario que subas el libro para ver el problema.

Saludos.
\\//_

Buenas tarde este es el libro y el problema que tengo es que pasa como en la imagen en los datos saliente que me muestra todos quedan en blanco como si fuera encontrado coincidencia para no determinara en que fila fue.

• Excel1.rar(18,2 KB)

Prueba esto.

Saludos.
\\//_

• Excel2.rar(19,1 KB)