Depuración de macro
Publicado por Daniel (1 intervención) el 03/10/2019 22:38:38
Hola chicos,
Soy nuevo en el foro y necesito de su valiosa ayuda.
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
Soy nuevo en el foro y necesito de su valiosa ayuda.
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
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
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
Valora esta pregunta
0
