Macro para buscar contenido.
Buenas tardes, estoy realizando un proyecto que incluye varias macros con diferentes objetivos, y una de ellas ( que no la puedo realizar ), tendría la función de buscar determinados contenidos en las celdas, al encontrá coincidencia que se seleccione toda la fila que contiene esa celda, se corte y se pegue más abajo en la misma hoja.
Por Ejemplo: Supongamos que tenemos una hoja1 con datos desde A1 hasta A100
El contenido que la macro buscaría está en la hoja2 en la celda A1 = "TD".
Me gustaría que al ejecuar la macro la misma identifique las celdas en la hoja1 rango A1:A100 que tengan dicho contenido "TD", seleccione toda la fila, la corte y la peque en la celda A101. Pero que no se quede con el primer resultado si hay más coincidencias que las siga poniendo en A102 y así...
La macro la correría desde un CommandButton.
Se agradece cualquier comentario de ayuda o de sugerencia, estoy hace unos días intentando y no me sale.
Por Ejemplo: Supongamos que tenemos una hoja1 con datos desde A1 hasta A100
El contenido que la macro buscaría está en la hoja2 en la celda A1 = "TD".
Me gustaría que al ejecuar la macro la misma identifique las celdas en la hoja1 rango A1:A100 que tengan dicho contenido "TD", seleccione toda la fila, la corte y la peque en la celda A101. Pero que no se quede con el primer resultado si hay más coincidencias que las siga poniendo en A102 y así...
La macro la correría desde un CommandButton.
Se agradece cualquier comentario de ayuda o de sugerencia, estoy hace unos días intentando y no me sale.
1 Respuesta
Respuesta de Elsa Matilde
1
Esta es la rutina según modelo:
Sub cortaypega()
'desarrollada por Elsamatilde el 25/06/09
ActiveSheet.Range("L7").Select
'recorremos el rango de criterios hasta encontrar 1 celda vacía = fin
final = ActiveSheet.Range("A65536").End(xlUp).Row + 1
While ActiveCell.Value <> ""
fila2 = final
fila = ActiveCell.Row
dato = ActiveCell.Value & "*" 'armo el criterio como las letras + lo que siga
While conta = 0
Set busco = ActiveSheet.Range("B8:B1000").Find(dato, LookIn:=xlValues, lookat:=xlWhole)
If Not busco Is Nothing And busco.Row < fila2 Then 'lo encontró
filabusco = busco.Row
Range(Cells(filabusco, 1), Cells(filabusco, 10)).Cut Destination:=Cells(final, 1)
Range(Cells(filabusco, 1), Cells(filabusco, 10)).Delete Shift:=xlUp
fila2 = fila2 - 1
'repito el bucle para todas las entradas del mismo criterio
Else
conta = 1
End If
Wend
'continúo con el sgte criterio
ActiveSheet.Range("L" & fila + 1).Select
conta = 0
Wend
End Sub
Sdos. No olvides finalizar la consulta
Elsa
Sub cortaypega()
'desarrollada por Elsamatilde el 25/06/09
ActiveSheet.Range("L7").Select
'recorremos el rango de criterios hasta encontrar 1 celda vacía = fin
final = ActiveSheet.Range("A65536").End(xlUp).Row + 1
While ActiveCell.Value <> ""
fila2 = final
fila = ActiveCell.Row
dato = ActiveCell.Value & "*" 'armo el criterio como las letras + lo que siga
While conta = 0
Set busco = ActiveSheet.Range("B8:B1000").Find(dato, LookIn:=xlValues, lookat:=xlWhole)
If Not busco Is Nothing And busco.Row < fila2 Then 'lo encontró
filabusco = busco.Row
Range(Cells(filabusco, 1), Cells(filabusco, 10)).Cut Destination:=Cells(final, 1)
Range(Cells(filabusco, 1), Cells(filabusco, 10)).Delete Shift:=xlUp
fila2 = fila2 - 1
'repito el bucle para todas las entradas del mismo criterio
Else
conta = 1
End If
Wend
'continúo con el sgte criterio
ActiveSheet.Range("L" & fila + 1).Select
conta = 0
Wend
End Sub
Sdos. No olvides finalizar la consulta
Elsa
