Macro très très lente. Pourquoi?

[benoua]

Re bonjour à tous!
J'ai un nouveau souci à vous soumettre.
Voilà j'ai fait une macro qui fonctionnait très bien jusqu'à ce matin mais là elle est devenu très lente (plus de 10 minutes contre quelques secondes auparavant), j'ai redémarré l'ordi mais rien n'y fait. Je ne comprends pas pourquoi.
J'ai laissé le screenupdating pour voir ce que fait la macro et il semble qu'elle fasse tout lentement comparé à avant.
Et c'est au niveau des étapes que j'ai mis en gras que ca semble le plus posé problème :

Sub Bouton1_QuandClic()
Dim i As Integer
i = 1

Columns("A:F").Select
Selection.Copy
Sheets("Extr formate").Visible = True

Sheets("Extr formate").Select
Columns("A:A").Select
ActiveSheet.Paste
Range("G3").Select
ActiveCell.FormulaR1C1 = _
"=+IF(RC[-3]="""",IF(LEFT(RC[-6],1)=""T"","""",IF(MID(RC[-6],6,1)=""/"","""",MID(RC[-6],3,2))),R[-1]C)"
Range("H3").Select
ActiveCell.FormulaR1C1 = _
"=+IF(RC[-4]="""",IF(LEFT(RC[-7],1)=""T"","""",IF(MID(RC[-7],6,1)=""/"","""",MID(RC[-7],7,2))),R[-1]C)"
Range("G3:H3").Select

Selection.AutoFill Destination:=Range("G3:H3000")
Columns("G:H").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Cut
Columns("A:B").Select
Selection.Insert Shift:=xlToRight


[B]i = 1
While i < 3000
If Range("D" & i).Value = "" Then
Rows(i).ClearContents
i = i + 1
Else
i = i + 1
End If
Wend[/B]


Range("A2:H3000").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNorm

Rows(1).Delete
Rows(1).Delete
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("B:B").Select
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("A:B").Select
Selection.NumberFormat = "00"
Columns("F:G").Select
Selection.NumberFormat = "m/d/yyyy"

[B]i = 1
While i < 3001
If Range("D" & i).Value = "" Then
Rows(i).Clear
i = i + 1
Else
i = i + 1
End If
Wend[/B]

Sheets("Tableau Absences").Select
Range("A2:H2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents


Sheets("Extr formate").Select
Range("A1:H1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Tableau Absences").Select
Range("A2").Select
ActiveSheet.Paste Link:=True

Sheets("TC").Select

ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotCache.Refresh
ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotSelect "Prénom[All]" _
    , xlLabelOnly, True

Range("D4").Select
Selection.Copy
Range("E4").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("G9:G10").Select
Columns("E:E").ColumnWidth = 9.43
Sheets("Extr formate").Visible = False
Application.ScreenUpdating = True

End Sub

Si quelqu'un a une idée de sur ce qui a rendu ma macro si lente, je suis preneur!

 

[benoua]

Re : Macro très très lente. Pourquoi?

Désolé en fait j'ai trouvé la solution tout seul (promis j'avais déjà cherché avant!). Ca ne venait pas de la macro mais d'une formule sur une feuille du classeur.
Peut on supprimer la discussion?

 

[Softmama]

Re : Macro très très lente. Pourquoi?

bonjour Benoua,

remplace ton passage en gras par :

Range("D1:D3000").SpecialCells(xlCellTypeBlanks).EntireRow.Clear

(Même si t'as trouvé ce qui ralentissait ta macro, cette ligne te permettra d'accélérer ce passage de ta macro d'au moins 90%)

 

[benoua]

Re : Macro très très lente. Pourquoi?

Effectivement ca l'optimise pas mal!!
Et ca m'a appris une nouvelle ligne de code au passage qui me sera très utile à l'avenir!
Merci beaucoup.