Depuración de macro para que tarde menos
Tengo una macro ya hecha que consiste en ir sacando datos desde un libro y consolidarlos en otro. Lo que pasa es que la macro tarda muchisimo, por lo que quisiera saber si se puede depurar un poco para que no tarde tanto.
También les agradecería me indicaran si estoy cometiendo algún error.
Esta es la macro en cuestión
Sub FINAL().
'-----------------------------------------------
'Inhabilitar parpadeo de pantalla
'-----------------------------------------------
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
'-----------------------------------------------
'Variables
'-----------------------------------------------
Dim ARCHIVO As String
ARCHIVO = ActiveCell.Value
'-----------------------------------------------
'Ventana de número de hojas
'-----------------------------------------------
Cantidad = Application.InputBox("Cantidad de hojas")
'-----------------------------------------------
'Inicio de macro
'-----------------------------------------------
Workbooks(ARCHIVO).Sheets("Ejecucion").Select
For i = 1 To Cantidad
'-----------------------------------------------
'Copiar información del cliente (ID, kernel, nit, capacidad y mesas)
'-----------------------------------------------
Windows(ARCHIVO).Activate
Range("F5:G9").Copy
Windows("Informe.xlsm").Activate
Sheets("Control").Select
Range("B1").End(xlDown).Activate
ActiveCell.Offset(1, 0).Select
ActiveCell.PasteSpecial xlValues
'Pegar nombre del consultor
ActiveCell.Offset(0, -1).Select
Windows(ARCHIVO).Activate
CONSULTOR = Range("B5:E5").Value
Windows("Informe.xlsm").Activate
ActiveCell.FormulaR1C1 = CONSULTOR
Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.Offset(0, 1).End(xlDown).Offset(0, -1)), Type:=xlFillCopy
'-----------------------------------------------
'Copiar información de los cocteles
'-----------------------------------------------
Windows(ARCHIVO).Activate
Range("I5:AF14").Copy
Windows("Informe.xlsm").Activate
Sheets("Consolidado").Select
Range("B12").End(xlDown).Select
ActiveCell.Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, -1).Select
'-----------------------------------------------
'Copiar nombre del establecimiento del cliente
'-----------------------------------------------
Windows(ARCHIVO).Activate
Selection.End(xlToLeft).Select
nombre = Range("B2:E4").Value
Application.CutCopyMode = False
Windows("Informe.xlsm").Activate
ActiveCell.FormulaR1C1 = nombre
Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.Offset(0, 1).End(xlDown).Offset(0, -1)), Type:=xlFillCopy
ActiveCell.Offset(0, 51).Select
'-----------------------------------------------
'Copiar tipo de impacto del cliente
'-----------------------------------------------
Windows(ARCHIVO).Activate
IMPACTO = Range("J21:K21").Value
Application.CutCopyMode = False
Windows("Informe.xlsm").Activate
ActiveCell.FormulaR1C1 = IMPACTO
Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.Offset(0, 1).End(xlDown).Offset(0, -1)), Type:=xlFillCopy
ActiveCell.Offset(0, -1).Select
'-----------------------------------------------
'Copiar segmentación del cliente
'-----------------------------------------------
Windows(ARCHIVO).Activate
SEGMENTACION = Range("J20:K20").Value
Application.CutCopyMode = False
Windows("Informe.xlsm").Activate
ActiveCell.FormulaR1C1 = SEGMENTACION
Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.Offset(0, 1).End(xlDown).Offset(0, -1)), Type:=xlFillCopy
ActiveCell.Offset(0, 1).Select
ActiveCell.Offset(0, -26).Select
'-----------------------------------------------
'Copiar nombre del consultor
'-----------------------------------------------
Windows(ARCHIVO).Activate
CONSULTOR = Range("B5:E5").Value
Windows("Informe.xlsm").Activate
ActiveCell.FormulaR1C1 = CONSULTOR
Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.Offset(0, 1).End(xlDown).Offset(0, -1)), Type:=xlFillCopy
'-----------------------------------------------
'Cambiar de hoja de cliente y finalizar macro
'-----------------------------------------------
Windows(ARCHIVO).Activate
ActiveSheet.Next.Activate
Next i
Windows("Informe.xlsm").Activate
Sheets("Ejecucion").Select
ActiveCell.Offset(1, 0).Select
'-----------------------------------------------
'Habilitar parpadeo de pantalla
'-----------------------------------------------
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False
End Sub
[Hola
Entre las cosas que más tiempo demoran en una macro, está el uso de Select, Selection y Activate. Lee esto de aquí:
https://abrahamexcel.blogspot.com/2017/12/el-uso-y-abuso-de-select-y-selection-en.html
por cierto, las líneas que colocas para, supuestamente, acelerar la macro, pues no es tanto así, te las comento:
Application.ScreenUpdating = False 'Esta siempre ayuda Application.Calculation = xlCalculationManual 'esta solo es útil s tienes miles de fórmulas en las que dependan de celdas que sean modificadas por la macro y/o funciones volátiles como HOY Application.EnableEvents = False 'esto solo ayuda si tienes eventos de la hoja que se vean afectados por la macro ActiveSheet.DisplayPageBreaks = False ' solo para estos casos: https://support.microsoft.com/es-pe/help/199505/macro-performance-slow-when-page-breaks-are-visible-in-excel
