Cómo disminuyo el tiempo de ejecución de esta macro?

He vuelto a ejecutar la macro quitando el último select de
la hoja inicio y tarda 2 minutos!!

muchas gracias

A ver si esto te sirve:

Sub xxxxxxxxxxxx()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'evitas que se calcule la hoja al cambiar una celda
P = 4

'Totalhojas = Worksheets.Count 'no la necesitas porque

ya estas usando

FOR-EACH

Sheets("Inicio").Select
While Cells(P, 1).Value = Empty
'la instruccion DO-LOOP ejecuta las instrucciones al

menos una vez,

'While la ejecuta solo si se cumple la condicion, te

ahorra una

ejecucion
'Do
ProyectoActual = Cells(P, 1).Value
s = 2
While Cells(3, s).Value = Empty
''Do
Sh = 1
Recursos = " "
For Each HOJA In

ActiveWorkbook.Worksheets 'remplaza al DO-LOOP de

hojas
''Do
''Sheets(Sh).Select 'no necesiatas selccionar

cada hoja que

analizes
'si al final vas a

seleccionar la hoja inicial

''Nombre = Worksheets(Sh).Name
''If Nombre <> "Inicio" And Nombre <> "Resumen-

Nombre" Then

If HOJA.Name <> "Inicio" And HOJA.Name

<> "Resumen-Nombre" Then

PSh = 4

While HOJA.Cells(PSh, 1).Value = Empty
''Do
If HOJA.Cells(PSh, 1).Value =

ProyectoActual Then

If HOJA.Cells(PSh, s).Value > 0 Then
Recursos = Recursos & Nombre & "(" &

HOJA.Cells(PSh,

s).Value & ")" & ", "
End If
End If
PSh = PSh + 1
Wend 'Loop Until Cells(PSh, 1).Value = Empty
End If
Sh = Sh + 1
Next 'Loop Until Sh > Totalhojas

'Sheets("Inicio").Select 'se quita porque la hoja

Inicio ya esta

activa

If Recursos <> " " Then
Cells(P, s).Value = Left(Recursos, Len

(Recursos) - 2)

End If
s = s + 1
Wend 'Loop Until Cells(3, s).Value = Empty

Sheets("Inicio").Select

P = P + 1
Wend 'Loop Until Cells(P, 1).Value = Empty
Application.Calculation =

xlCalculationAutomatic 'recalculas la hoja

Application.ScreenUpdating = True
Range("A1").Select
MsgBox "Fin del Proceso"
End Sub

Saludos
Rene Moreno

____________________________________________________
Para responder elimine el texto NOSPAM de la dirección de

envío

"Manuel Romero" <mromerop.arroba.quita.esto.hotmail.com>

escribió en el

mensaje news:

Lo primero es colocar Application.ScreenUpdating=False

al comienzo de la

macro para que no actualice la pantalla, pruebalo y

mira cuanto se reduce

el

tiempo

"Tani" escribió en

el mensaje

news:99C65EB2-9E7E-4E78-86DB-

> Este es el código de la macro:
>
> P = 4
>
> Totalhojas = Worksheets.Count
>
> Sheets("Inicio").Select
> Do
> ProyectoActual = Cells(P, 1).Value
>
> s = 2
> Do
> Sh = 1
> Recursos = " "
> Do
> Sheets(Sh).Select
> Nombre = Worksheets(Sh).Name
> If Nombre <> "Inicio" And Nombre

<> "Resumen-Nombre"

Then

> PSh = 4
> Do
> If Cells(PSh, 1).Value =

ProyectoActual Then

> If Cells(PSh, s).Value > 0

Then

> Recursos = Recursos &

Nombre & "(" &

Cells(PSh, s).Value & ")" & ", "
> End If
> End If
> PSh = PSh + 1
> Loop Until Cells(PSh, 1).Value =

Empty

> End If
> Sh = Sh + 1
> Loop Until Sh > Totalhojas
>
> Sheets("Inicio").Select
> If Recursos <> " " Then
> Cells(P, s).Value = Left(Recursos, Len

(Recursos) - 2)

> End If
> s = s + 1
> Loop Until Cells(3, s).Value = Empty
>
> Sheets("Inicio").Select
>
> P = P + 1
> Loop Until Cells(P, 1).Value = Empty
> Application.ScreenUpdating = True
> Range("A1").Activate
> MsgBox "Fin del Proceso"
> End Sub
>
>
>
> Hola:
> Os pido una ayuda para mi siguiente macro:
> Empiezo a recorrer una hoja con 160 filas y 54

columnas,

> para cada una de las celdas voy a leer 16 hojas

de cálculo

> en el mismo libro, que tienen el mismo rango que

la

> inicial.
> Entonces la macro la he creado con 4 bucles

(Do..Loop

> Until) para hacer todo ese recorrido que serian:

en la

> hoja que parte la macro: 8.480 celdas y por cada

una de

> ellas recorro 8480 * 16. Todo este cálculo se

tarda mas de

> 30 minutos
> Cómo puedo reducir este tiempo??
> Muchas gracias
>

.