Macro copier / coller tres lente

bonjour a tous , j' ai un soucis pour le lancement d'une macro de copie-coller conditionnelle qui est un peu lente , est ce qu' il y a moyen d'optimiser cette macro SVP .

NB: je fait appel a cette macro 5 fois avec la fonction CALL puisque je fais cette taches sur 5 colonnes différentes ( A1:A25),(D1:D25).......

Sub CopyOn2()

    Dim rc As Range
    Dim rf As Range
    Dim l As Long

         With Worksheets("Liste1")
                Set rf = .Range("D1:D55")
                Set rc = .Range("D1:D55")

    For l = 1 To rf.Cells.SpecialCells(xlCellTypeLastCell).Row

        If rf.Cells(l, 1).Font.ColorIndex = 1 Then

            rc.Cells(l, 2).Value = rf.Cells(l, 1).Value

            Else

            rc.Cells(l, 2).Clear

        End If

    Next l

    End With

End Sub

Merci d'avance

Salut,

J'ai peur de te dire une bêtise mais bon je tente quand même, essaies ceci dans un fichier à part ou une copie si possible (vu que je n'ai pas le tien pour essayer)

==> En gros à l'activation de la macro, désactiver le calcul automatique des cellules et la mise à jour de l'écran puis réactiver le calcul automatique une fois la manip effectuée.

Dis-moi si ça marche et si quelqu'un voit que j'ai dit une bêtise n'hésitez pas

Sub CopyOn2()

    Dim rc As Range
    Dim rf As Range
    Dim l As Long
    Dim Calc As Long

Calc = Application.Calculation

   With Application 
 .Calculation = xlCalculationManual
 .Screenupdating = False
  End With

         With Worksheets("Liste1")
                Set rf = .Range("D1:D55")
                Set rc = .Range("D1:D55")

    For l = 1 To rf.Cells.SpecialCells(xlCellTypeLastCell).Row

        If rf.Cells(l, 1).Font.ColorIndex = 1 Then

            rc.Cells(l, 2).Value = rf.Cells(l, 1).Value

            Else

            rc.Cells(l, 2).Clear

        End If

    Next l

    End With
Application.Calculation = xlCalculationAutomatic   
Application.Calculation = Calc
End Sub

Cdlt

oui ca marche impec , merci bcq