Macro para copiar rango si una celda especifica es mayor que cero.
Nuevamente vengo a solicitar su ayuda con una macro que intento realizar les explico lo que intento hacer.
Tengo un formato donde cambio la información muchas veces al día, cada vez que la cambio debo imprimir una copia y guardar esos datos en otra hoja que tiene por nombre "consolidado".
Del formato original copio 2 rangos que tiene 4 filas que es donde esta la información que necesito guardar, esos rangos tienen formulas.
La cosa esta que cuando copio el rango y lo pego en la hoja consolidado siempre me pega las 4 filas y la siguiente vez 4 filas abajo (allí es donde esta el problema) los rangos de 4 filas no siempre están llenos en ocasiones solo tiene datos 2 filas, todo el rango tiene formulas como esta
=+SI(A17>0;A17;"")
excel dice que no están vacías y pega la siguiente información 4 filas abajo, dejando las dos que no utilice en blanco.
Lo que intento es que excel pegue la información junta sin dejar espacio en blanco.
Este es el código de mi macro, si son tan amables de darme alguna idea o indicarme donde esta mi error.
Sub formatorecargado() ' 'Range("C2").End(xlDown).Offset(1, 5).Select 'EVITA EL PARPADEO Application.ScreenUpdating = False 'Evita que se disparen macros de evento si las hubiere Application.EnableEvents = False 'COPIA MATERIA PRIMA hoja = ActiveSheet.Name Sheets(hoja).Select Range("AA2:AM5").Select Selection.Copy 'PEGA Sheets("Consolidado").Select Range("C1").End(xlDown).Offset(1, -2).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False 'COPIA MATERIAL DE EMPAQUE Sheets(hoja).Select Range("AO2:BA5").Select Selection.Copy 'PEGA Sheets("Consolidado").Select Range("Q1").End(xlDown).Offset(1, -2).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Sheets(hoja).Select Range("A10").Select Application.CutCopyMode = False 'RETORNA EL PARPADEO A SU ESTADO Application.ScreenUpdating = True 'REGRESAN LOS EVENTOS DE OTRAS MACROS Application.EnableEvents = True End Sub