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

[Anastasia]

Bonjour à tous,
Je viens de passer la journée à fouiller les forums et le net pour trouver une solution mais je n'ai rien trouvé de concluant.
J'ai essayé d'adapter certaine VBA trouvé sur internet mais ça ne fonctionne pas.
C'est pour ça que je me permet de m'adresser à vous.
Je souhaiterais faire une feuille de synthèse reprenant les véhicules ou l'ont doit intervenir. Et je souhaiterais que lorsque tout est ok la ligne disparaisse de la synthèse.
Ces véhicules seront mis en évidence dans la feuille de base "Véhicule" par une couleur, suite à une mise en forme conditionnelle.
Je vous remercie pour l'aide que vous pouvez m'apporter.
Bonne soirée

 

[sylvanu]

Bonsoir Anastasia, et bienvenue sur XLD,
Dit autrement, vous voulez récupérer en Synthèse tous les véhicules qui ont en feuille Véhicule colonne U :
"Réparation à prévoir" ou "En réparation" ou" Accidenté" ou "HS" ?

 

[Anastasia]

Bonsoir,
Oui tout à fait !!!
Ainsi que les véhicules qui ont un problème de carte grise dans la colonne Q et qui ont un contrôle technique expiré dans la colonne R, si cela est possible.

 

[sylvanu]

Bonsoir,
Avec ce que j'ai compris, un essai en PJ avec :

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

La macro s'exécute automatiquement lorsqu'on sélectionne la feuille Synthèse.

( Je suis parti du principe qu'il n'y avait pas de retouche "manuelle" de la feuille synthèse, donc je l'efface avant de la reconstruire. Comme semble le montrer votre macro Test )

 

[Anastasia]

Merci beaucoup pour votre rapidité.
C'est génial !!!
J'ai les mêmes fichiers, à l'identique pour 5 autres entreprises, je peux copier la VBA tel quelle est dans visual basic > Module ?
Encore merci à vous

 

[sylvanu]

Bonsoir,
Si toutes les pages et toutes les plages sont identiques, bien sur que vous pouvez copier coller le module VBA.

 

[Anastasia]

Super, merci pour tout !!!
Bonne soirée