Macro para copiar un rango de celdas siempre que se cumpla una condicion

A ver si me puedes echar una mano con una macro, estoy iniciandomo en vba y de momento soy incapaz.

Necesito una macro para que recorra de B2:B1000 en busca de "CANCELADO", teniendo en cuenta que en este rango de celdas puedes hacer celdas en blanco, y cada "CANCELADO" que encuentre me copie el rango desde A hasta D y lo pegue en la hoja "CANCELADOS" del mismo libro a partir de A2.

Cada vez que ejecute la macro debe sobrescribir los que haya en la hoja "CANCELADOS"

Te lo pongo con imágenes, parto de la siguiente tabla en la hoja 1

Al ejecutar la macro me deberá copiar en otra hoja llamada "CANCELADOS" los registros A5:D5 y A8:D8 a partir de A2. En caso de que cambie los registros de la de origen que los vuelva a sobreescribir

1 respuesta

Respuesta
2

Te adjunto la macro que solicitas. Se coloca en un módulo. Luego podrás ejecutarla desde un atajo de teclado o un botón o desde el mismo menú Macros (estos temas los tengo explicados en la sección Macros de mi sitio).

Sub pasaCancelados()
'x Elsamatilde
'limpia la hoja Cancelados de datos anteriores
'posible error de que no exista la hoja
On Error GoTo sinHoja
Sheets("CANCELADOS").Rows("2:10000").ClearContents
On Error GoTo 0
'1er fila de destino
fily = 2
'guarda la última fila con datos
filx = Range("B" & Rows.Count).End(xlUp).Row
[B2].Select
'recorre col B hasta el fin de datos
While ActiveCell.Row <= filx
If UCase(ActiveCell) = "CANCELADO" Then
    Range("A" & ActiveCell.Row & ":D" & ActiveCell.Row).Copy Destination:=Sheets("CANCELADOS").Range("A" & fily)
    fily = fily + 1
End If
'paso a la fila siguiente
ActiveCell.Offset(1, 0).Select
Wend
MsgBox "Fin del proceso", , "FIN"
Exit Sub
sinHoja:
MsgBox "No se encuentra la hoja denominada 'CANCELADOS', verifique y ejecute nuevamente el proceso.", , "ERROR"
End Sub

Sdos y no olvides valorar la respuesta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas