¿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...

1 Respuesta

Respuesta
1
Coloca esta instrución al inicio de cada macro:
Application.ScreenUpdating = False
'luego prueba y me cuentas cómo te fue.
'"El conocimiento le pertenece al mundo"

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas