Macro que busque un valor y copie la fila entera

Espero me puedan ayudar,
Necesito hacer una macro que me busque un valor en la hoja 1 y copie toda la fila a la hoja 2 sin sobreescribir el ultimo registro, y una vez copiada la fila, la elimine de la hoja 1

1 Respuesta

Respuesta
3
Pues aquí tienes la macro que lo hace. La hoja a la que copio los datos la he llamado "COPIADOS". La macro se ejecuta en la pestaña donde realiza la búsqueda
Sub copiar_y_borrar()
quebusco = InputBox("que dato quieres buscar")
If quebusco = "" Then Exit Sub
Set busca = ActiveSheet.Range("a2:a" & Range("a10000").End(xlUp).Row).Find(quebusco, LookIn:=xlValues, lookat:=xlWhole)
If Not busca Is Nothing Then
busca.EntireRow.Copy
Sheets("copiados").Cells(Range("a10000").End(xlUp).Row + 1, 1).PasteSpecial Paste:=xlValues
busca.EntireRow.Delete
Application.CutCopyMode = False
End If
End Sub
No olvides finalizar y puntar
Hola Experto!
Muchas gracias por tu pronta respuesta! Sin embargo quisiera preguntarte como puedo modificar la macro para que copie todas las filas que contengan el valor a buscar y en la hoja "Copiados" que me deje una fila  vacía para identificar cada vez que se corrió la macros.
Si lo requieres te puedo enviar el archivo para mayor comprensión
Saludos y muchas gracias!
Aquí tienes amigo. Te cuento mi plan: la base de datos está en la pestaña "hoja1" y los copiaremos en la pestaña "copiados". Los datos de la hoja1 empiezan desde A2 hacia abajo y esa es la columna por la que voy a buscar (lógicamente en la fila 1 de la hoja1 están los encabezados)
Sub copiar_y_borrar()
columna = Range("bz1").End(xlToLeft).Column
quebusco = InputBox("que dato quieres buscar")
If quebusco = "" Then Exit Sub
ActiveSheet.Range("a1").CurrentRegion.Sort key1:=Range("a1"), order1:=xlAscending, Header:=xlYes, ordercustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Set busca = ActiveSheet.Range("a2:a" & Range("a10000").End(xlUp).Row).Find(quebusco, LookIn:=xlValues, lookat:=xlWhole)
If Not busca Is Nothing Then
ubica = busca.Address
Range(ubica).Select
valor = ActiveCell.Value
fila = ActiveCell.Row
contarsi = Application.WorksheetFunction.CountIf(Columns(1), valor)
Range(Cells(fila, 1), Cells(fila + contarsi - 1, columna)).Copy
Sheets("copiados").Select
Cells(Range("copiados!a10000").End(xlUp).Row + 1, 1).PasteSpecial Paste:=xlValues
Selection.End(xlDown).Offset(1, 0).Value = "*****************"
Sheets("hoja1").Select
Range(Cells(fila, 1), Cells(fila + contarsi - 1, columna)).EntireRow.Delete
Application.CutCopyMode = False
End If
End Sub
Recuerda finalizar y puntuar
Te mando una corrección. Esta fila:
Selection.End(xlDown).Offset(1, 0).Value = "*****************"
Sustitúyela por esta:
Selection.Offset(1, 0).Value = "*****************"
Sigue fallando, rectifico lo anterior:
Sutituye esta fila:
?Selection.End(xlDown).Offset(1, 0).Value = "*****************"
por esto:
Do While ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = "******************"

Hola Experto, tengo malas noticias, ya realize los cambios que me sugeriste,  y al correr la macro no sucede nada. en el editor de visual basic no me muestra error alguno. Cambie el nombre de las hojas en mi archivo  a "hoja1" y "copiados" y  sigue sin suceder nada.. Donde  esta el error?

como siempre, gracias por todo tu apoyo.

saludos

La macro funciona perfectamente. Dime un mail y te lo mando.

Ya te lo he mandado.

Finaliza y puntúa

Que bárbaro!! Te volaste la barda!! muchísimas gracias la macro  funciona a la perfección.!

yo te doy 7 estrellas!

Gracias por todo tu apoyo, no sabes de la que me has salvado!

SALUDOS! =)

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas