Optimisation d'une macro

Bonjour à tous,

J'ai fait enregistré une macro que j'ai légèrement modifié pour qu'elle puisse s'adapter au nombre de ligne de la feuille.

Sauf que quand je l'utilise, ça fait planter Excel. Je pense donc à un problème d'optimisation du programme, mais je ne m'y connais pas assez en VBA pour l'optimiser moi-même.

Pourriez-vous me donner votre avis et peut-être m'aider à optimiser mon programme ?

En dessous le code ainsi que le type de document sur lequel je l'utilise.

Merci bien !

Sub MiseEnForme()
'
' MiseEnForme Macro
'

'
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 2), Array(2, 2), Array(3, 1), Array(4, 2), Array(5, 2), Array(6, 5), _
        Array(7, 1), Array(8, 2)), TrailingMinusNumbers:=True
    Sheets.Add After:=ActiveSheet
    Sheets(1).Select
    Application.Run "test"
    Sheets("Feuil1").Select
    Columns("A:A").Select
    Selection.NumberFormat = "0#"" ""##"" ""##"" ""##"" ""##" 'mise au format numero de telephone
    Columns("B:B").Select
    Selection.NumberFormat = "0" 'mise au format de nombre sans chiffre significatif
    Columns("D:D").Select
    Selection.NumberFormat = "0#"" ""##"" ""##"" ""##"" ""##" 'mise au format numero de telephone
    Columns("H:H").ColumnWidth = 16
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "Créneau Horaire"
    Range("I2").Select
    Columns("I:I").ColumnWidth = 14.71
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "Jour"
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "Nombre de jour"
    Range("K3").Select
    Columns("K:K").ColumnWidth = 15.57
    Range("I2").Select 'remplissage de la colonne creneau horaire
    ActiveCell.FormulaR1C1 = _
        "=TEXT(LEFT(RC[-2],LEN(RC[-2])-4)&"":00"",""hh:mm"")&""-""&TEXT(LEFT(RC[-2],LEN(RC[-2])-4)&"":59"",""hh:mm"")"
    Range("I2").Select
    Selection.AutoFill Destination:=Range("I2:I" & Rows.Count), Type:=xlFillDefault
    Range("I2:I" & Rows.Count).Select
    ActiveWindow.SmallScroll Down:=-342
    ActiveWindow.ScrollRow = 1
    Range("J2").Select 'remplissage de la colonne Jour
    ActiveCell.FormulaR1C1 = "=TEXT(RC[-4],""jjjj"")"
    Range("J2").Select
    Selection.AutoFill Destination:=Range("J2:J" & Rows.Count), Type:=xlFillDefault
    Range("J2:J" & Rows.Count).Select
    ActiveWindow.SmallScroll Down:=-687
    Range("K2").Select 'remplissage de la colonne Nombre de jour
    ActiveCell.FormulaR1C1 = "=SUM(IF(FREQUENCY(C[-5],C[-5])>0,1))"
    Range("K2").Select
    Selection.AutoFill Destination:=Range("K2:K" & Rows.Count), Type:=xlFillDefault
    Range("K2:K" & Rows.Count).Select
    ActiveWindow.SmallScroll Down:=-360
    ActiveWindow.ScrollRow = 1
End Sub

Bonjour,

Laisser le code dans le classeur. (Le code fourni sur le fil n'est pas récupérable...)

A+

Bonjour galopin01,

Oui, désolé. Je l'ai mis dans un module.

Bonsoir,

Essaie comme ça ?

Sub MiseEnForme()
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 2), Array(2, 2), Array(3, 1), Array(4, 2), Array(5, 2), Array(6, 5), _
        Array(7, 1), Array(8, 2)), TrailingMinusNumbers:=True
    Sheets.Add After:=ActiveSheet
    Sheets(1).Select
    Application.Run "test"
   With Sheets("Feuil1")
   .Columns("A:A").NumberFormat = "0#"" ""##"" ""##"" ""##"" ""##"
   .Columns("B:B").NumberFormat = "0"
   .Columns("D:D").NumberFormat = "0#"" ""##"" ""##"" ""##"" ""##"
   .Columns("H:I").ColumnWidth = 16
   .Columns("K:K").ColumnWidth = 16
   .Range("I1") = "Créneau Horaire"
   .Range("J1") = "Jour"
   .Range("K1") = "Nombre de jour"
   .Range("I2").Formula = _
        "=TEXT(LEFT(G2,LEN(G2)-4)&"":00"",""hh:mm"")&""-""&TEXT(LEFT(G2,LEN(G2)-4)&"":59"",""hh:mm"")"
   .Range("I2").AutoFill Destination:=.Range("I2:I" & .Rows.Count), Type:=xlFillDefault
   .Range("J2").Formula = "=TEXT(F2,""jjjj"")"
   .Range("J2").AutoFill Destination:=.Range("J2:J" & .Rows.Count), Type:=xlFillDefault
   .Range("K2").Formula = "=SUM(IF(FREQUENCY(F:F,F:F)>0,1))"
   .Range("K2").AutoFill Destination:=.Range("K2:K" & .Rows.Count), Type:=xlFillDefault
   End With
End Sub

A+

Bonjour galopin01,

Merci de ton aide. Malheureusement ça ne marche toujours pas. As-tu une idée de ce qui bloque ? Peut-être que le problème vient de mon ordinateur.

Voilà mes caractéristiques :

• Windows 10 Professionnel
• Intel Celeron 1.60GHz
• 8Go de ram

Voir fichier joint

Ça marche nickel !

Merci beaucoup galopin01.

Bonne continuation à toi !