Buscador Macro google

Así me llegó el archivo, igual abre tu archivo original y copia el código de la macro que yo modifiqué en el módulo 1.
Public Sub buscador(datobuscar As String)'Autor: Pavel Enrique Ramos, 2006Dim filaInicio As Integer, columnaInicio As Integer, filaDato1 As Integer, filadato As Integer, columnaDato As Integer, i As ByteDim datoEncontradoDim contador As IntegerDim cadenaValores As Stringcontador = 0'ActiveSheet.UnprotectApplication.ScreenUpdating = FalseApplication.EnableEvents = False With Range("zona").ClearContents 'Limpia el rango donde se muestra la búsqueda.Font.Bold = False.Font.Color = vbBlackEnd WithfilaInicio = Range("inicio").Row 'Fila del rango inicio ("$B$4"), varía si se modifica el formato de la hojacolumnaInicio = Range("inicio").Column 'Columna del rango inicio ("$B$4"), varía si se modifica el formato de la hoja With Worksheets("INVENTARIO").Range("A1:D5000") Set datoEncontrado = .Find(datobuscar) If Not datoEncontrado Is Nothing Then filaDato1 = datoEncontrado.Row Do filadato = datoEncontrado.Row columnaDato = datoEncontrado.Column For i = 0 To 3 'Cambiar el 3 por 4 si se requiere otra columna cadenaValores = Sheets("INVENTARIO").Cells(filadato, i + 1).Value 'ID CAT 'With ActiveSheet.Cells(filaInicio + i, columnaInicio) With Cells(filaInicio, columnaInicio) Select Case i Case 2 .Value = "DESCRIPCIÓN " & cadenaValores Case 3 .Value = "CANTIDAD " & cadenaValores Case Else .Value = cadenaValores End Select If i = 0 Then ActiveSheet.Hyperlinks.Add Anchor:=Range(.Address), Address:="", SubAddress:= _ "INVENTARIO!" & datoEncontrado.Address, TextToDisplay:=cadenaValores If InStr(1, cadenaValores, datobuscar, 1) > 0 Then .Characters(Start:=InStr(1, cadenaValores, datobuscar, 1) + 12, Length:=Len(datobuscar)).Font.Bold = True End If End With columnaInicio = columnaInicio + 1 Next contador = contador + 1 'filaInicio = filaInicio + 1 'contador de filas columnaInicio = Range("inicio").Column 'Columna del rango inicio ("$B$4"), varía si se modifica el formato de la hoja proxima: Set datoEncontrado = .FindNext(datoEncontrado) 'Busca el siguiente dato If datoEncontrado.Row = filadato Then filadato = filadato + 1: GoTo proxima: filaInicio = filaInicio + 1 Loop While Not datoEncontrado Is Nothing And datoEncontrado.Row <> filaDato1 End IfEnd WithSheets("PRINCIPAL").Label1.Caption = contador & " registros(s) encontrado(s)." 'Muestra en el Label 1 los registros encontrados Application.EnableEvents = True Application.ScreenUpdating = False 'ActiveSheet.ProtectEnd Sub
Prueba y me comentas.
Saludos. Dam