Acceleration d`une macro de copie de couleur de cellules

[flosauveur69]

Bonjour à tous,

J`ai réalisé cette macro qui me récupère la couleur de certaines cellules dans une autre page. Le problème c`est qu`elle met plusieurs dizaines de minutes avant de se terminer et je trouve cela bizarre.
J`ai l`impression qu`elle me copie chaque valeur une à une et prends plusieurs secondes pour chaque. Y a-t-il une motif de code ou autre qui serait à faire pour l`accélérer ?

Sub KPI_color()

Dim i

Application.ScreenUpdating = False

For i = 4 To 500
Worksheets("Calcul").Range("S" & i).Value = Worksheets("Daily followup-UNIVIC").Range("K" & i).Interior.Color
Worksheets("Calcul").Range("V" & i).Value = Worksheets("Daily followup-UNIVIC").Range("N" & i).Interior.Color
Worksheets("Calcul").Range("Y" & i).Value = Worksheets("Daily followup-UNIVIC").Range("T" & i).Interior.Color
Worksheets("Calcul").Range("AE" & i).Value = Worksheets("Daily followup-LEU").Range("I" & i).Interior.Color
Worksheets("Calcul").Range("AH" & i).Value = Worksheets("Daily followup-LEU").Range("L" & i).Interior.Color
Worksheets("Calcul").Range("AK" & i).Value = Worksheets("Daily followup-LEU").Range("O" & i).Interior.Color
Worksheets("Calcul").Range("AP" & i).Value = Worksheets("Daily followup-2oo3").Range("F" & i).Interior.Color
Worksheets("Calcul").Range("AS" & i).Value = Worksheets("Daily followup-2oo3").Range("I" & i).Interior.Color
Worksheets("Calcul").Range("AV" & i).Value = Worksheets("Daily followup-2oo3").Range("L" & i).Interior.Color

Next i

End Sub

 

[Robert]

Re : Acceleration d`une macro de copie de couleur de cellules

Bonjour Flosauveur, bonjour le forum,

Pas sûr que ce soit plus rapide en passant par des tableaux dynamiques car il faut de toutes manières passer les cellules une par une. Essaie comme ça (non testé) :

Sub KPI_color()
Dim i As Integer
Dim c As Object
Dim tc1(4 To 500) As Variant
Dim tc2(4 To 500) As Variant
Dim tc3(4 To 500) As Variant

Set c = Sheets("Calcul")
Application.ScreenUpdating = False
For i = 4 To 500
With Sheets("Daily followup-UNIVIC")
    For i = 4 To 500
        tc1(i) = .Range("K" & i).Interior.ColorIndex
        tc2(i) = .Range("N" & i).Interior.ColorIndex
        tc3(i) = .Range("T" & i).Interior.ColorIndex
        c.Range("S" & i).Value = tc1(i)
        c.Range("V" & i).Value = tc2(i)
        c.Range("Y" & i).Value = tc3(i)
    Next i
End With
With Sheets("Daily followup-LEU")
    For i = 4 To 500
        tc1(i) = .Range("I" & i).Interior.ColorIndex
        tc2(i) = .Range("L" & i).Interior.ColorIndex
        tc3(i) = .Range("O" & i).Interior.ColorIndex
        c.Range("AE" & i).Value = tc1(i)
        c.Range("AH" & i).Value = tc2(i)
        c.Range("AK" & i).Value = tc3(i)
    Next i
End With
With Sheets("Daily followup-2oo3")
    For i = 4 To 500
        tc1(i) = .Range("F" & i).Interior.ColorIndex
        tc2(i) = .Range("I" & i).Interior.ColorIndex
        tc3(i) = .Range("L" & i).Interior.ColorIndex
        c.Range("AP" & i).Value = tc1(i)
        c.Range("AS" & i).Value = tc2(i)
        c.Range("AV" & i).Value = tc3(i)
    Next i
End With
Application.ScreenUpdating = True
End Sub

 

[flosauveur69]

Re : Acceleration d`une macro de copie de couleur de cellules

Bonjour,

merci mais ce n`est pas plus rapide

 

[laetitia90]

Re : Acceleration d`une macro de copie de couleur de cellules

bonjour flosauveur69,Robert
si tu pouvez mettre un fichier exemple plus simple??

 

[Robert]

Re : Acceleration d`une macro de copie de couleur de cellules

Bonjour Flosauveur, Laetitia, bonjour le forum,

Robert

Ben quoi Laetitia, arrête de rire... C'est vexant à la fin...

 

[flosauveur69]

Re : Acceleration d`une macro de copie de couleur de cellules

Salut à tous,

Désolé de répondre tardivement mais comme beaucoup de Français j`étais en vacances.

J`ai trouvé une solution et même deux assez simples, la première faire tourner cette macro sur un PC plus rapide et la seconde c`est que cette macro est très longue la première fois qu’on la lance car elle doit remplir toutes les cellules mais ensuite, lorsque ce n`est qu`une MAJ, c`est très rapide.

Merci à vous