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

1 respuesta

Respuesta
1

Presentanos tu hoja a ver en que podemos mejora tu macro

Me podrías dar un correo para enviar el archivo, busque como subirlo a la página pero

No pude encontrar como.

[email protected] este mi e-mail

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas