Boa Tarde! Gostaria de saber se alguém poderia me ajudar com a seguite macro:

Possuo 100 números distintos que equivalem a uma variavel de uma equacao. Para cada um desses numeros rodo um goalseek para que a equacao seja igual a zero. A segunda varialvel gerada, resultante do goalseek, salvo ao lado da primeira variavel. Sendo assim tenho a variavel 1 e a variavel 2 que igualam a minha equacao a 0.

Repito esse procedimento 100 vezes, sendo assim, no final, tenho 100 pares de variaveis que igualam a mesma equacao a 0.

O meu problema é que essa macro demora 20 segundos para rodar, sendo que antes, o mesmo codigo demorava 5 segundos na mesma maquina para rodar.

Alguem pode me ajudar???

Obrigado!!!

Segue o codigo abaixo:

Sub SIMT()
'
' SIM Macro
' Macro recorded 26/3/2010 by Administrator

'Breakeven'

Application.ScreenUpdating = False 'No screen flasches

Sheets("Program").Visible = True

Range("D43").Select
ActiveCell.FormulaR1C1 = "=R[98]C[-2]"
Range("D47").Select
Range("D47").GoalSeek Goal:=0, ChangingCell:=Range("E43")
Range("E43").Select
Selection.Copy

Range("C141").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("D43").Select
ActiveCell.FormulaR1C1 = "=R[99]C[-2]"
Range("D47").Select
Range("D47").GoalSeek Goal:=0, ChangingCell:=Range("E43")
Range("E43").Select
Selection.Copy

Range("C142").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Selection.Offset(0, -1).Select 'jumps to the PREVIOUS column'
Selection.Offset(1, 0).Select 'jumps to the NEXT row'

Do Until ActiveCell.Value = ""

ActiveCell.Select 'parte 2'
Selection.Copy
Range("D43").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("D47").Select
Range("D47").GoalSeek Goal:=0, ChangingCell:=Range("E43")
Range("E43").Select
Selection.Copy

Range("C141").Select
ActiveCell.End(xlDown).Select
Selection.Offset(1, 0).Select 'jumps to the NEXT row'
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Selection.Offset(0, -1).Select 'jumps to the PREVIOUS column'
Selection.Offset(1, 0).Select 'jumps to the NEXT row'

Loop

Sheets("L&S Manager").Select
Range("D23").Select

End Sub