Copiado de 400 registros de un libro a otro de Excel

3 envíos / 0 nuevos
Último envío
Mau Cázares
Imagen de Mau Cázares
Offline
última acción: Hace 3 semanas 1 día
alta: 28/07/2017 - 14:07
Puntos: 25
Copiado de 400 registros de un libro a otro de Excel

Muy buenos días:
Realicé una macro cuya función es extraer la información del libro "A" y pegarla en el libro "B". Sin embargo el tiempo que esto tarda en ejecutarse me parece realmente excesivo ya que está tardando en promedio 8 minutos. Mi macro está seecionada en 3 módulos, el primero es de donde más datos se extraen pues repite el proceso en 310 filas copiando 13 campos de cada una. Cronometrando el tiempo, se demora 5 minutos en hacer la copia de estas 313 filas por lo que solicito su ayuda adjuntando a continuación el código para que por favor me apoyen indicando cómo se podría mejorar el rendimiento para que el tiempo de ejecución se reduzca pues en este momento no es tan funcional para el usuario final por la cuestión del tiempo que tarda en ejecutarse.

 

Sub Sueldos()


Workbooks("BaseDatos.xls").Worksheets("Sueldos").Activate

IFILA = Worksheets("Sueldos").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row


    For I = 8 To 321

   Workbooks("BaseDatos.xls").Activate

   Range("AE" & IFILA).Value = CveUniversidad

   Range("A" & IFILA).Value = siglas

   Workbooks(nombre & ".xls").Worksheets("HojaSueldos").Activate

   Range("B" & I).Copy 'clave de puesto

   Workbooks("BD Sueldos 2017.xls").Activate

   Range("AA" & IFILA).PasteSpecial Paste:=xlPasteValues

   Workbooks(nombre & ".xls").Activate

   Range("C" & I).Copy 'Area

   Workbooks("BD Sueldos 2017.xls").Activate

   Range("AB" & IFILA).PasteSpecial Paste:=xlPasteValues

   Workbooks(nombre & ".xls").Activate

   Range("D" & I).Copy 'Funcion

   Workbooks("BD Sueldos 2017.xls").Activate

   Range("AD" & IFILA).PasteSpecial Paste:=xlPasteValues

   Workbooks(nombre & ".xls").Activate

   Range("E" & I).Copy 'Anuies

   Workbooks("BD Sueldos 2017.xls").Activate

   Range("AC" & IFILA).PasteSpecial Paste:=xlPasteValues

   If Range("AC" & IFILA).Value = "Otro" Then Range("AC" & IFILA).Value = "z"

   Workbooks(nombre & ".xls").Activate

   Range("F" & I).Copy 'Puesto

   Workbooks("BD Sueldos 2017.xls").Activate

   Range("E" & IFILA).PasteSpecial Paste:=xlPasteValues

   Workbooks(nombre & ".xls").Activate

   Range("H" & I).Copy 'Ocup2017

   Workbooks("BD Sueldos 2017.xls").Activate

   Range("Z" & IFILA).PasteSpecial Paste:=xlPasteValues

   Workbooks(nombre & ".xls").Activate

   Range("G" & I).Copy 'Titulo

   Workbooks("BD Sueldos 2017.xls").Activate

   Range("Y" & IFILA).PasteSpecial Paste:=xlPasteValues

   Workbooks(nombre & ".xls").Activate

   Range("I" & I).Copy 'Sueldo

   Workbooks("BD Sueldos 2017.xls").Activate

   Range("F" & IFILA).PasteSpecial Paste:=xlPasteValues

   Workbooks(nombre & ".xls").Activate

   Range("J" & I).Copy 'Sindicalizados

   Workbooks("BD Sueldos 2017.xls").Activate

   Range("AF" & IFILA).PasteSpecial Paste:=xlPasteValues

   Workbooks(nombre & ".xls").Activate

   Range("K" & I).Copy 'Obs

   Workbooks("BD Sueldos 2017.xls").Activate

   Range("AH" & IFILA).PasteSpecial Paste:=xlPasteValues

 

   IFILA = IFILA + 1

 

Next I

End Sub

De antemano muchas gracias. Quedo pendiente de sus valiosos consejos.

Etiquetas: 

pacomegia
Imagen de pacomegia
Offline
última acción: Hace 6 horas 49 mins
Nivel 1 - 200 puntosNivel 2 - 500 puntosNivel 3 - 1000 puntosNivel 4 - 2000 puntosNivel 5 - 4000 puntosadministrador
alta: 27/12/2006 - 23:26
Puntos: 7210
Echando un vistazo rápido a

Echando un vistazo rápido a tu macro, veo que activa y desactiva una hoja y otra para copiar y pegar. Esto hace que Excel esté continuamente actualizando la pantalla para mostrar una hoja o la otra, y en ese proceso normalmente tarda mucho.

Lo que puedes hacer como primera medida para agilizar tu macro es desactivar la actualización de pantalla al principio de tu macro, y volver a activarla cuando termine

al inicio añade esta línea a tu código

Application.ScreenUpdating = False

Se supone que cuando la macro termine se volverá a poner en automático, pero por si acaso, al final del código, cuando termines todo el proceso vuelve a activarlo

Application.ScreenUpdating = True

Mide los tiempos con estos cambios a ver cuánto mejora la situación antes de seguir probando otras cosas

 

 

Data Tools Suite
datos y tablas con Excel

Cron
Imagen de Cron
Offline
última acción: Hace 10 horas 27 mins
Nivel 1 - 200 puntosNivel 2 - 500 puntosNivel 3 - 1000 puntosNivel 4 - 2000 puntosNivel 5 - 4000 puntos
alta: 23/06/2010 - 12:30
Puntos: 8370
Añadido a lo que dice Paco,

Añadido a lo que dice Paco, puedes utilizar con cuidado lo siguiente:

Application.Calculation = xlCalculationManual

Recuerda volverlo siempre al final a 

Application.Calculation = xlCalculationAutomatic

para dejar las cosas como estaban. Personalmente siempre lo suelo hacer con un control de errores, de manera que, incluso cuando salte un error, devolverá el cálculo a automático.

Te sorprenderá todo lo que acelera las macros esto. La última en la que lo he hecho ha bajado de unos 16-18 minutos a unos 20 segundos.

Un saludo