Macro muy lenta, ayuda a simplificar

Hola buen día a tod@s:
Espero que me puedan ayudar para hacer una macro más eficiente:

Son cuatro empresas, 2 libros por cada empresa un balance y estado de resultados, estos archivos se bajan en TXT del sistema y les pongo el nombre de Balance Provisional 1, 2, 3 y 4 cualquiera que se el caso o la empresa y el estado de resultados es lo mismo solo que con el nombre Resultados.

Los archivos ya vienen con el ancho delimitado, asi que solo se abren con Excel y lo exporto a mi libro llamado Consolidado, ya que lo exporte, en el primero que es el balance provisional 1, las columnas C, D y E las corto y las inserto al final en las columnas AM, AN, AO (para no dejar las columnas en blanco le doy instertar celdas costadas porque son el saldo acumulado y no me sirven), después de eso inserto la siguiente formula en la nueva columna E "=SI.ERROR(B2+C2-D2,D2)" hasta la fila 1800 de esa misma columna, después de eso copio y pego ese rango con formulas en las columnas H, K, N, Q, T, W, Z, AC, AF, AI, AL, terminado ese proceso copio todo la hoja Balance Provisonal 1 y la pego en una hoja llamada "Balance Empresa 1" y el mismo proceso es para las empresas 2, 3 y 4, esas hojas estan ligas con la función BUSCARV a una sola Hoja llamada "BG consolidado".
Para la Hoja 2 que es el estado de resultados, solo exporto a mi libro consolidado, y después de eso solo copio lo de la Hoja "Resultados 1" y la pego en una Hoja llamada "ER Empresa 1" y así para la demás empresas. Y esas hojas también estan ligas a una Hoja llamada "ER consolidado" con la función "BUSCARV".
Al final elimino las Hojas Balance Provisional 1 y Resultados 1, y asi con las hojas de las otras empresas, eso de copiar y pegar en otras hojas lo hago porque si eliminó la hoja "Balance Empresa 1" o "Resultados 1 me marca error en mis formulas de "BUSCARV"

la macro es la siguiente

Sub PRUEBA()
Windows("Balance provisional PRUEBA.txt").Activate
Sheets("Balance provisional PRUEBA").Move before:=Workbooks( _
"CONSOLIDADO.xlsm").Sheets(1)
Windows("Resultados PRUEBA.txt").Activate
Sheets("Resultados PRUEBA").Move before:=Workbooks("CONSOLIDADO.xlsm"). _
Sheets(1)
Sheets("Balance provisional PRUEBA").Select
Columns("C:E").Select
Selection.Cut
Range("A1").Select
Selection.End(xlDown).Select
Range("A1").Select
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.Insert Shift:=xlToRight
' Formulas_balanza Macro_3
Sheets("Balance provisional PRUEBA").Select
Range("E2:E1800").Select
Selection.FormulaR1C1 = "=IFERROR(RC[-3]+RC[-2]-RC[-1],RC[-1])"
Selection.Copy
Range("H2").Select
ActiveSheet.Paste
Range("K2").Select
ActiveSheet.Paste
Range("N2").Select
ActiveSheet.Paste
Range("Q2").Select
ActiveSheet.Paste
Range("T2").Select
ActiveSheet.Paste
Range("W2").Select
ActiveSheet.Paste
Range("Z2").Select
ActiveSheet.Paste
Range("AC2").Select
ActiveSheet.Paste
Range("AF2").Select
ActiveSheet.Paste
Range("AI2").Select
ActiveSheet.Paste
Range("AL2").Select
ActiveSheet.Paste
' Mover_balanza_4 Macro
Sheets("Balance provisional PRUEBA").Select
Selection.CurrentRegion.Select
Selection.Copy
Sheets("PRUEBA Balanza").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Resultados PRUEBA").Select
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("PRUEBA ER").Select
Range("A1").Select
ActiveSheet.Paste
Sheets(Array("Balance provisional PRUEBA", "Resultados PRUEBA")). _
Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
End Sub

Descargar archivo

Añade tu respuesta

Haz clic para o