Buscar y pegar datos.
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
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
1 Respuesta
Respuesta de ma_ramirez_r
1
La lógica de la Rutina debiera funcionar pero tenia algunos errores, aquí te envío las correcciones, pruébala y me comentas si te funciona, sino indicame el error que te da, si sale todo bien, no olvides de cerrar la pregunta y evaluarme.
Sub Buscar()
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
lngColumna = 2
lngFila = 5
lngPegarColumna = 6
lngPegarFila = 5
strObjetoBuscar = Range("G2").Text
If strObjetoBuscar = "" Then GoTo 99
strObjetoBuscar = LCase(strObjetoBuscar)
For n = lngFila To lngUltimaFila
lngResultado = InStr(1, Cells(n, 3), strObjetoBuscar, vbTextCompare)
If lngResultado > 0 Then
Range(Cells(n, 2), Cells(n, 4)).Copy
Range(Cells(lngPegarFila, lngPegarColumna)).PasteSpecial
lngPegarFila = lngPegarFila + 1
End If
Next n
Application.CutCopyMode = False
Range("G2").Select
99:
End Sub
Sub Buscar()
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
lngColumna = 2
lngFila = 5
lngPegarColumna = 6
lngPegarFila = 5
strObjetoBuscar = Range("G2").Text
If strObjetoBuscar = "" Then GoTo 99
strObjetoBuscar = LCase(strObjetoBuscar)
For n = lngFila To lngUltimaFila
lngResultado = InStr(1, Cells(n, 3), strObjetoBuscar, vbTextCompare)
If lngResultado > 0 Then
Range(Cells(n, 2), Cells(n, 4)).Copy
Range(Cells(lngPegarFila, lngPegarColumna)).PasteSpecial
lngPegarFila = lngPegarFila + 1
End If
Next n
Application.CutCopyMode = False
Range("G2").Select
99:
End Sub
Hola, otra vez yo aquí, al parecer no funciono, quizás sea por que estoy especificando mal las celdas
Tengo esta tabla:
http://piszeg.bay.livefilestore.com/y1pqAIJAiS7aejwMlzOXJn3UZms4ibE_Fm_pOCHb4vZ7h0pgvOS86gVpLjVjn3mk7Mr8vCZb6uXhx3ldRs8MJ_pIKY9DWKy_RHG/ifn.xls
Había puesto el macro para que en la celda L5 con valor numérico, ya que seria el numero para que me pueda filtrar desde a hasta f y luego los pegue según el registro que haya puesto para búsqueda, pero al momento de hacerlo me borra todo. Espero me puedas ayudar y disculpa por tantas molestias.
Gracias.
Tengo esta tabla:
http://piszeg.bay.livefilestore.com/y1pqAIJAiS7aejwMlzOXJn3UZms4ibE_Fm_pOCHb4vZ7h0pgvOS86gVpLjVjn3mk7Mr8vCZb6uXhx3ldRs8MJ_pIKY9DWKy_RHG/ifn.xls
Había puesto el macro para que en la celda L5 con valor numérico, ya que seria el numero para que me pueda filtrar desde a hasta f y luego los pegue según el registro que haya puesto para búsqueda, pero al momento de hacerlo me borra todo. Espero me puedas ayudar y disculpa por tantas molestias.
Gracias.
http://www.4shared.com/file/40081135/7f96d50/ifn.html
En esa dirección te dejo el mismo archivo que me enviaste con dos posibles soluciones.
1) A través del mismo filtro, en la celta "B1" digitas el dato a buscar e inmediatamente al darle enter te filtrará todos los datos que cumplan con el código ingresado. La macro de este ejemplo está copiado en las dos primeras hojas, es decir, "Comisiones" y "Roxana".
2) Es digitar el código en la misma celda "B1" y al momento de darle enter te sacara la información y la copiara a partir de la celda "H4"
Espero esto te sirva, atento a tus consultas, y si era lo que necesitabas no olvides de cerrar la pregunta y evaluarme.
En esa dirección te dejo el mismo archivo que me enviaste con dos posibles soluciones.
1) A través del mismo filtro, en la celta "B1" digitas el dato a buscar e inmediatamente al darle enter te filtrará todos los datos que cumplan con el código ingresado. La macro de este ejemplo está copiado en las dos primeras hojas, es decir, "Comisiones" y "Roxana".
2) Es digitar el código en la misma celda "B1" y al momento de darle enter te sacara la información y la copiara a partir de la celda "H4"
Espero esto te sirva, atento a tus consultas, y si era lo que necesitabas no olvides de cerrar la pregunta y evaluarme.
