Buscar y pegar datos.

Hola, vi la solución de esta pregunta que hicieron el año pasado, debido a que estoy metido en el mismo problema. Ya apliqué el código que enviaron de solución, pero la solución hace lo siguiente: por ejemplo, si estoy buscando en una lista el número "3" el resultado que arrojará será el de pegar todos los que haya encontrado en la lista que contengan el número "3", el "33", "534", "1003", etc porque estos datos contienen el número buscado., PERO, lo que yo necesito es que me pegue únicamente aquellos registros que tienen el número 3 sólito.
A propósito, el código que enviaron de solución anterior fue:
Sub Botón1_Haga_clic_en()
Dim lngUltimaFila As Long
Dim strObjetoBuscar As String
Dim lngResultado As Long
Dim lngColumna As Long, lngFila As Long
Dim lngPegarColumna As Long, lngPegarFila As Long
Dim x As Integer, n As Integer
Range("G5:H4000").ClearContents
Range("A1").SpecialCells(xlLastCell).Select
lngUltimaFila = ActiveCell.Row
'COLUMNA + FILA DONDE EMPEZAR/TERMINAR LA BUSQUEDA
lngColumna = 2
lngFila = 5
'COLUMNA + FILA DONDE EMPEZAR A PEGAR RESULTADOS
lngPegarColumna = 6
lngPegarFila = 5
strObjetoBuscar = Range("G2").Text
If strObjetoBuscar = "" Then GoTo 99
'MINUSCULAS
strObjetoBuscar = LCase(strObjetoBuscar)
'BUCLE: REALIZAR BUSQUEDA
For n = lngFila To lngUltimaFila
'EVALUACIÓN
lngResultado = InStr(1, Cells(n, 2), strObjetoBuscar, vbTextCompare)
'COPIAR /PEGAR
If lngResultado > 0 Then
Range(Cells(n, 2), Cells(n, 4)).Copy
Range(Cells(lngPegarFila, lngPegarColumna), Cells(lngPegarFila, ingpegarcolumna + 2)).Select
ActiveSheet.Paste
lngPegarFila = lngPegarFila + 1
End If
Next n
'APARCAR
Application.CutCopyMode = False
Range("G2").Select
99:
End Sub
Muchas gracias,. Espero me puedan ayudar.
Agustín HErnández
Hola buen día:
No se si me puedan ayudar
Necesito crear un macro en excel, que su función sea la siguiente..
Tengo información de algunas tiendas lo que necesito es que al momento de insertar un valor numérico (el numero de la tienda) en una celda esta me filtre y pegue las veces que encuentre esa tienda y la información que contenga.
Un ejemplo seria así
No tienda Nombre de tienda Tipo
1 x as
Luego al momento de introducir algún dato en la celda especifica, me pegue los datos de los iguales que encontró, anteriormente había encontrado un macro para esto pero no me ha funcionado, aun no entiendo porque.
Sub Buscar()
'dimensiones
Dim lngUltimaFila As Long
Dim strObjetoBuscar As String
Dim lngResultado As Long
Dim lngColumna As Long, lngFila As Long
Dim lngPegarColumna As Long, lngPegarFila As Long
Dim x As Integer, n As Integer
'quitar resultados anteriores
Range("G5:H4000").ClearContents
'columna + fila donde empezar/terminar búsqueda
lngColumna = 2
lngFila = 5
lngUltimaFila = Columns(lngColumna). _
Range("A65536").End(xlUp).Row
'columna + fila donde empezar a pegar resultados
lngPegarColumna = 6
lngPegarFila = 5
'objeto a buscar
strObjetoBuscar = Range("G2").Text
If strObjetoBuscar = "" Then GoTo 99
'minúsculas
strObjetoBuscar = LCase(strObjetoBuscar)
'bucle: realizar búsqueda
For n = lngFila To lngUltimaFila
'evaluación
lngResultado = InStr(1, Cells(n, 3), _
strObjetoBuscar, vbTextCompare)
'copiar/pegar
If lngResultado > 0 Then
Range(Cells(n, 2), Cells(n, 4)).Copy
Range( _
Cells(lngPegarFila, lngPegarColumna), _
Cells(lngPegarFila, lngPegarColumna + 2)) _
.Select
ActiveSheet.Paste
lngPegarFila = lngPegarFila + 1
End If
Next n
'aparcar
Application.CutCopyMode = False
Range("G2").Select
99:
End Sub

Espero me pueda ayudar.
Por su atención gracias