Copiar rango de celdas de una hoja a otra de acuerdo a condicional

A ver si pueden brindarme una ayuda.

He desarrollado una macro que inserta un rango de celdas desde una hoja (01) a otra (02)

Asi:

Sub CopiarRangoActual()
Sheets("01").Select
Range("A1").CurrentRegion.Copy
Sheets("02").Select
Sheets("02").Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub

Lo que me gustaría es que filtrara los registros de B:B que sean mayor que cero y que solo copiara en la hoja 02 estos registros filtrados de acuerdo a la condición.

2 respuestas

Respuesta
1

Vamos a ver crea un botón en la hoja 1 donde tienes los datos que quieres copiar. Una vez hecho esto, doble clic en el botón y empezamos a realizar la programación

Private Sub Command_Button_Click

'Ocultamos el procedimiento para acelerar la macro

application.screenupddating=false

Creamos una variable donde vamos a almacenar el numero de la última celda con datos de la columna B

Dim uFila as double

Sheets("Hoja1"). Activate 'Activamos la hoja 1 (donde tenemos los datos que queremos copiar).

Activesheet. Range("b65536").end(xlup). Activate 'Nos desplazamos desde la ultima fila de excel hacia arriba para buscar la ultima celda que tiene datos)

uFila= activecell.row 'Pasamos a la variable uFila el numero de la fila.

Activesheet. Range("B1"). Activate 'Nos vamos a la celda B1

'Creamos un bucle for para recorrer las celdas de la columna B.

for x=1 to uFila 'Desde la fila 1 hasta la ultima que tenga datos....

valor_a_copiar=cells(x,2) 'Creamos una variable para almacenar el valor de la celda

if valor_a_copiar>0 then 'Si el valor de la variable valor_a_copiar (que es el valor que tiene la celda es mayor que 0, entonces....)

Sheets("Hoja2).activate 'Activa la hoja 2

Activesheet. Range("a65536").end(xlup).offset(1,0). Activate 'Activa la celda siguiente a la ultima con datos)

activecell.value=valor_a_copiar 'Copiar el valor de la variable en la celda vacía

'Una vez hecho todo esto volvemos a la hoja origen para que siga evaluando las celdas.

Sheets("Hoja1"). Activate

end if

next x

'Una vez acabado el proceso muestra un mensaje informando que se han copiado los datos

msgbox "Los datos han sido copiados satisfactoriamente",vbinformation,"DATOS COPIADOS"

application.screenupdating=True 'Mostramos los resultados.

End Sub

Muy bien, prueba esta macro y me cuentas como te fue.

Respuesta
-1

Si me pueden ayudar estoy tratando de grabar un rango de celdas de una hoja a otra y esta que acumule lo grabado. Es decir estoy intentando grabar comprar por medio de una factura y la factura tiene varios celdas pero no todas las celdas se utilizan en cada compra asi que solo lo que se rellana pasar a la otra hoja

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas