XL 2010 Macro qui tourne en boucle sur certains PC

[Sissou71]

Bonjour,

J'ai une macro assez simple qui sur mon PC s'éxécute rapidement et sur d'autres PC boucle avec un processeur qui monte/descend et oblige mes camarades à arreter Excel. J'aimerai savoir si cela est purement du au PC et sa configuration technique ou si juste en activant des compléments Excel mes collègues pourront résoudre le problème ?

Voici mon code qui prend un TCD en colle les valeurs / et ajouter des données, rien de bien complexe :

Sub RecupResultat()
'
' Supprime les Données déjà présentent dans l'onglet Résultat
Sheets("Resultat").Select
Cells.Select
Selection.Delete Shift:=xlUp

' Recupere le TCD et le copie
Sheets("Extraction Client").Select
ActiveSheet.PivotTables("TCDClient").PivotSelect "", xlDataAndLabel, True
Selection.Copy

' le colle dans l'onglet Resultat
Sheets("Resultat").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Insère une colonne et insère le mois et l'année
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
For k = 3 To Range("B" & Rows.Count).End(3).Row
x = Cells(k, 2)
Cells(k, 1) = Month(x) & "-" & Year(x)
Next
'insère le total
Columns("C:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
For k = 3 To Range("B" & Rows.Count).End(3).Row
Cells(k, 3).FormulaR1C1 = "=SUM(RC[1]:RC[23])"
Next

'copie/collage spécial du total
Columns("C:C").Select
Selection.Copy
Columns("C:C").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Insère le jour de la semaine (1= lundi et 7 = Dimanche)
Columns("C:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
For k = 3 To Range("B" & Rows.Count).End(3).Row
Cells(k, 3).FormulaR1C1 = "=WEEKDAY(RC[-1],2)"
Next

'Copie/collage Spécial
Columns("C:C").Select
Selection.Copy
Columns("C:C").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'met en forme les colonnes
Columns("B:B").Select
Selection.NumberFormat = "m/d/yyyy"
Columns("A:A").Select
Selection.NumberFormat = "mmm-yy"
Range("A2").Select
ActiveCell.FormulaR1C1 = "Mois"
Range("C2").Select
ActiveCell.FormulaR1C1 = "Jour Semaine"
Range("D2").Select
ActiveCell.FormulaR1C1 = "Total"
Columns("C:Z").Select
Selection.NumberFormat = "General"


'Supprime la 1ere ligne et met en forme les titres
Rows("1:1").Select
Selection.Delete Shift:=xlUp
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Bold = True
End Sub

 

[Lone-wolf]

Bonsoir Sissou71, le Forum 🙂

Avec tous ces Select et les boucles, je m'étonne pas que ça plante. Pourtant après 169 messages, tu devrais savoir que deux ou trois select ça passe, mais quand il y en a autant, il faut nettoyer le code.

' Supprime les Données déjà présentent dans l'onglet Résultat
Sheets("Resultat").Select
Cells.Select
Selection.Delete Shift:=xlUp

Ceci en une ligne: Sheets("Resultat").Cells.Delete Shift:=xlUP

Sheets("Extraction Client").PivotTables("TCDClient").Copy

With Sheets("Resultat")
    derL = .Range("a" & Rows.Count).End(xlUp).Row
    .Range("a1").PasteSpecial Paste:=xlPasteValues
    .Columns("A:A").Insert Shift:=xlToRight
    .Columns("C:C").Insert Shift:=xlToRight

    For k = 3 To derL
        x = .Cells(k, 2)
        .Cells(k, 1) = Month(x) & "-" & Year(x)
        .Cells(k, 3).FormulaR1C1 = "=SUM(RC[1]:RC[23])"
    Next

'met en forme les colonnes
.Columns("b3:b" & derL).NumberFormat = "m/d/yyyy"
.Columns("a3:a" & derL).NumberFormat = "mmm-yy"
.Range("a2").FormulaR1C1 = "Mois"
.Range("c2").FormulaR1C1 = "Jour Semaine"
.Range("d2").FormulaR1C1 = "Total"
.Columns("c3:z" & derL).NumberFormat = "General"
End With

Ensuite c'est quoi ce Binz?

Cells(k, 3).FormulaR1C1 = "=SUM(RC[1]:RC[23])" Ici en colonne C tu met la somme
Cells(k, 3).FormulaR1C1 = "=WEEKDAY(RC[-1],2)" et ensuite Weekday?? 😵

D'après les exemples donné, à toi de faire le reste. Et supprime le code que tu as mis en le mettant dans la balise Code VB.

 

[Sissou71]

Merci Lone Wolf, je vais regarder ca.
En fait j'ai du rajouter le jour de la semaine dernièrement et je l'ai ajouté sans me poser de questions