¿Agilizar macro para reducir tiempo de ejecución?
Hola a todos soy nuevo en esto de las macros, de antemano muchas gracias por lo que me puedan aportar, tengo la siguiente macro y me funciona bien pero no a la velocidad que quisiera, en rangos grandes se tarda y quisiera ideas para agilizarla.
En la Hoja 1 tengo una tabla dinámica, en la Hoja 2 tengo la Base y a partir de la base ejecuta la macro
Macro. (Botón Aceptar de mi formulario)
Private Sub Aceptar_sif_Click()
fila_inicial = Val(textfila_inicial)
fila_final = Val(textfila_final)
Dim fila As Integer
Dim fila2 As Integer
Dim fila3 As Integer
Dim fila4 As Integer
Dim i As Integer
Dim i2 As Integer
Dim ultimafila As Integer
Dim ultimafila2 As Integer
Dim Hoja1 As Worksheet
Dim Hoja2 As Worksheet
Dim Hoja3 As Worksheet
'Elimina la hoja llamada REDUCE si es que existe
Application.DisplayAlerts = False
For Each Hoja1 In Worksheets
If Hoja1.Name = "REDUCE" Then
Hoja1.Delete
End If
Next Hoja1
'Elimina la hoja llamada AMPLIA si es que existe
Application.DisplayAlerts = False
For Each Hoja2 In Worksheets
If Hoja2.Name = "AMPLIA" Then
Hoja2.Delete
End If
Next Hoja2
'Elimina la hoja llamada BASESIF si es que existe
Application.DisplayAlerts = False
For Each Hoja3 In Worksheets
If Hoja3.Name = "BASESIF" Then
Hoja3.Delete
End If
Next Hoja3
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count) 'Crea una nueva Hoja al final
fila2 = (fila_final + 2) - fila_inicial 'Define la posición de la última fila
For fila = 2 To fila2 'Ubica desde el rango de las filas donde introduciremos los datos
Sheets(3).Select 'Selecciona la hoja numero 3 sin importar como se llame
ActiveSheet.Name = "BASESIF" 'Le cambia el nombre a la hoja seleccionada por: "BASESIF"
'Le agrega los títulos a las columnas en la fila 1
Cells(1, 1).Value = "ESTATUS"
Cells(1, 2).Value = "FAP"
Cells(1, 3).Value = "FFOLIO"
Cells(1, 4).Value = "FSOLICITUD"
Cells(1, 5).Value = "FTIPO"
Cells(1, 6).Value = "FOFREF"
Cells(1, 7).Value = "FOFFECH"
Cells(1, 8).Value = "FUNIRES"
Cells(1, 9).Value = "FRAMO"
Cells(1, 10).Value = "FGPOFUN"
Cells(1, 11).Value = "FFUNCION"
Cells(1, 12).Value = "FSUBFUN"
Cells(1, 13).Value = "FPARTIGAS"
Cells(1, 14).Value = "FACTINS"
Cells(1, 15).Value = "FPP"
Cells(1, 16).Value = "FPI"
Cells(1, 17).Value = "FCUENTA"
Cells(1, 18).Value = "FOG"
Cells(1, 19).Value = "FPARTIDA"
Cells(1, 20).Value = "FTIPOGASTO"
Cells(1, 21).Value = "FFTEFINAN"
Cells(1, 22).Value = "FCONCEPTO"
Cells(1, 23).Value = "FCEC"
Cells(1, 24).Value = "FENE"
Cells(1, 25).Value = "FFEB"
Cells(1, 26).Value = "FMAR"
Cells(1, 27).Value = "FABR"
Cells(1, 28).Value = "FMAY"
Cells(1, 29).Value = "FJUN"
Cells(1, 30).Value = "FJUL"
Cells(1, 31).Value = "FAGO"
Cells(1, 32).Value = "FSEP"
Cells(1, 33).Value = "FOCT"
Cells(1, 34).Value = "FNOV"
Cells(1, 35).Value = "FDIC"
Cells(1, 36).Value = "TOTAL"
'Copia los datos de la Hoja 2 a la Hoja 3
Cells(fila, 1).Value = "AUTORIZADO"
Cells(fila, 2).Value = Sheets(2).Cells(fila + (fila_inicial - 2), 3).Value
Cells(fila, 3).Value = Sheets(2).Cells(fila + (fila_inicial - 2), 4).Value
Cells(fila, 4).Value = Sheets(2).Cells(fila + (fila_inicial - 2), 5).Value
Cells(fila, 5).Value = Sheets(2).Cells(fila + (fila_inicial - 2), 6).Value
Cells(fila, 6).Value = Sheets(2).Cells(fila + (fila_inicial - 2), 7).Value
Cells(fila, 7).Value = Sheets(2).Cells(fila + (fila_inicial - 2), 8).Value
Cells(fila, 8).Value = "m7k"
Cells(fila, 9).Value = "12"
Cells(fila, 10).Value = Sheets(2).Cells(fila + (fila_inicial - 2), 9).Value...
En la Hoja 1 tengo una tabla dinámica, en la Hoja 2 tengo la Base y a partir de la base ejecuta la macro
Macro. (Botón Aceptar de mi formulario)
Private Sub Aceptar_sif_Click()
fila_inicial = Val(textfila_inicial)
fila_final = Val(textfila_final)
Dim fila As Integer
Dim fila2 As Integer
Dim fila3 As Integer
Dim fila4 As Integer
Dim i As Integer
Dim i2 As Integer
Dim ultimafila As Integer
Dim ultimafila2 As Integer
Dim Hoja1 As Worksheet
Dim Hoja2 As Worksheet
Dim Hoja3 As Worksheet
'Elimina la hoja llamada REDUCE si es que existe
Application.DisplayAlerts = False
For Each Hoja1 In Worksheets
If Hoja1.Name = "REDUCE" Then
Hoja1.Delete
End If
Next Hoja1
'Elimina la hoja llamada AMPLIA si es que existe
Application.DisplayAlerts = False
For Each Hoja2 In Worksheets
If Hoja2.Name = "AMPLIA" Then
Hoja2.Delete
End If
Next Hoja2
'Elimina la hoja llamada BASESIF si es que existe
Application.DisplayAlerts = False
For Each Hoja3 In Worksheets
If Hoja3.Name = "BASESIF" Then
Hoja3.Delete
End If
Next Hoja3
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count) 'Crea una nueva Hoja al final
fila2 = (fila_final + 2) - fila_inicial 'Define la posición de la última fila
For fila = 2 To fila2 'Ubica desde el rango de las filas donde introduciremos los datos
Sheets(3).Select 'Selecciona la hoja numero 3 sin importar como se llame
ActiveSheet.Name = "BASESIF" 'Le cambia el nombre a la hoja seleccionada por: "BASESIF"
'Le agrega los títulos a las columnas en la fila 1
Cells(1, 1).Value = "ESTATUS"
Cells(1, 2).Value = "FAP"
Cells(1, 3).Value = "FFOLIO"
Cells(1, 4).Value = "FSOLICITUD"
Cells(1, 5).Value = "FTIPO"
Cells(1, 6).Value = "FOFREF"
Cells(1, 7).Value = "FOFFECH"
Cells(1, 8).Value = "FUNIRES"
Cells(1, 9).Value = "FRAMO"
Cells(1, 10).Value = "FGPOFUN"
Cells(1, 11).Value = "FFUNCION"
Cells(1, 12).Value = "FSUBFUN"
Cells(1, 13).Value = "FPARTIGAS"
Cells(1, 14).Value = "FACTINS"
Cells(1, 15).Value = "FPP"
Cells(1, 16).Value = "FPI"
Cells(1, 17).Value = "FCUENTA"
Cells(1, 18).Value = "FOG"
Cells(1, 19).Value = "FPARTIDA"
Cells(1, 20).Value = "FTIPOGASTO"
Cells(1, 21).Value = "FFTEFINAN"
Cells(1, 22).Value = "FCONCEPTO"
Cells(1, 23).Value = "FCEC"
Cells(1, 24).Value = "FENE"
Cells(1, 25).Value = "FFEB"
Cells(1, 26).Value = "FMAR"
Cells(1, 27).Value = "FABR"
Cells(1, 28).Value = "FMAY"
Cells(1, 29).Value = "FJUN"
Cells(1, 30).Value = "FJUL"
Cells(1, 31).Value = "FAGO"
Cells(1, 32).Value = "FSEP"
Cells(1, 33).Value = "FOCT"
Cells(1, 34).Value = "FNOV"
Cells(1, 35).Value = "FDIC"
Cells(1, 36).Value = "TOTAL"
'Copia los datos de la Hoja 2 a la Hoja 3
Cells(fila, 1).Value = "AUTORIZADO"
Cells(fila, 2).Value = Sheets(2).Cells(fila + (fila_inicial - 2), 3).Value
Cells(fila, 3).Value = Sheets(2).Cells(fila + (fila_inicial - 2), 4).Value
Cells(fila, 4).Value = Sheets(2).Cells(fila + (fila_inicial - 2), 5).Value
Cells(fila, 5).Value = Sheets(2).Cells(fila + (fila_inicial - 2), 6).Value
Cells(fila, 6).Value = Sheets(2).Cells(fila + (fila_inicial - 2), 7).Value
Cells(fila, 7).Value = Sheets(2).Cells(fila + (fila_inicial - 2), 8).Value
Cells(fila, 8).Value = "m7k"
Cells(fila, 9).Value = "12"
Cells(fila, 10).Value = Sheets(2).Cells(fila + (fila_inicial - 2), 9).Value...
Respuesta de caranbis
1