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