Microsoft 365 VBA pour extraire des cellules en fonction de leurs couleurs (MFC)

Sub Worksheet_Activate()
    Dim L%, Lecr%, Etat
    Range("A3:F" & 1 + [A65500].End(xlUp).Row).ClearContents ' Effacement tableau
    Application.ScreenUpdating = False
    With Sheets("Véhicule")
        For L = 5 To .[A65500].End(xlUp).Row    ' Pour chaque véhicule
            Etat = .Cells(L, "U")               ' Copie l'état
            If Etat = "Réparation à prévoir" Or Etat = "En réparation" Or Etat = "Accidenté" Or Etat = "HS" _
                Or .Cells(L, "R") = "A faire" Or .Cells(L, "R") = "NON" Or .Cells(L, "Q") = "NON" Then ' A transférer
                ' On regarde ce qu'on doit rajouter
                If Application.CountIf([A:A], .Cells(L, "B")) = 0 Then ' Si 0 elle n'est pas présente
                    Lecr = 1 + [A65500].End(xlUp).Row   ' Ligne écriture dans Synthèse
                    CopierLigne Lecr, L ' On copie ou met à jour la ligne considérée
                End If
            End If
        Next L
    End With
End Sub
Sub CopierLigne(Lecr%, L%) ' Copie ligne L de Véhicule dans Lecr de Synthèse
    With Sheets("Véhicule")
        Cells(Lecr, "A") = .Cells(L, "B")   ' Nom ambulance
        Cells(Lecr, "B") = .Cells(L, "U")   ' Etat
        Cells(Lecr, "C") = .Cells(L, "V")   ' Réparations
        Cells(Lecr, "D") = .Cells(L, "Q")   ' Carte grise
        Cells(Lecr, "E") = .Cells(L, "R")   ' CT
        Cells(Lecr, "F") = .Cells(L, "W")   ' Date de mise en oeuvre
    End With
End Sub