benoua
XLDnaute Occasionnel
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 :
Si quelqu'un a une idée de sur ce qui a rendu ma macro si lente, je suis preneur!
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 :
Code:
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!