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.
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.
1 respuesta más de otro experto
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