Copie de couleur via recherchev en VBA

Bonjour à tous,

Je suis en train d'essayer d'automatiser un de mes fichier mais j'ai vraiment du mal.

Initialement j’utilisais les MFC mais vu le nombre de codes de référence qui augmente régulièrement, je n'y arrive plus.

De fait, je me suis tourné vers VBA (et là, c'est le drame!!)

Comme beaucoup j'ai commencé par enregistrer une macro mais il n'existe pas de façon de procéder qui fasse le RECHERCHEV.

Au final, je n'y arrive pas.

J'ai donc tout simplement choisi de me tourner vers le forum pour demander de l'aide.

Mon projet :

Mon fichier est composé de plusieurs feuilles :

• une feuille "RECAP" qui réalise mes calcul de coût, de suivi d'enveloppe ... et qui devra être coloriée par la macro;
• une feuille "Grille SB" qui contient ma base donnée "BDSB" composée d'un code unique, des informations diverses accompagnées par un code couleur

macro à réaliser :

- pour chaque ligne du tableau RECAP contenant une valeur dans la colonne D :

- Colorier les cases G,M,Q et V contenant l'info1 conformément à la couleur utilisée dans la base de donnés "BDSB" colonne C

- Colorier les cases H,N,R et W contenant l'info2 conformément à la couleur utilisée dans la base de donnée "BDSB"colonne D

- Colorier les cases I,O,S et X contenant l'info3 conformément à la couleur utilisée dans la base de donnée "BDSB"colonne A

La base de donnée "BDSB" correspond à la zone (grille SB! A2:G266) (info1 en colonne C; info2 en D et info3 en E)

La clé de recherche est le CODE

Le tableau "RECAP" contient en colonne D le champ "CODE" que l'on retrouve dans le tableau "Grille SB" en colonne A.

Je ne sais pas si j'ai été suffisamment clair.

Tous les éléments se retrouve dans le fichier joint.

Merci d'avance pour votre aide qui va me permettre de progresser.

Par avance: bonne fêtes de fin d'année

Bonjour,

Une piste. Dans un module standard que tu peux attacher à un bouton, exécuter avec F5 (le curseur devant être positionné dans la procédure) ou le petit triangle vert de lecture :

Sub Test()

    Dim PlageRecap As Range
    Dim PlageSB As Range
    Dim Cel As Range
    Dim CelTrouve As Range
    Dim I As Integer

    With Worksheets("RECAP"): Set PlageRecap = .Range(.Cells(4, 4), .Cells(.Rows.Count, 4).End(xlUp)): End With

    With Worksheets("Grille SB"): Set PlageSB = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With

    For Each Cel In PlageRecap

        Set CelTrouve = PlageSB.Find(Cel.Value, , xlValues, xlWhole)

        If Not CelTrouve Is Nothing Then

            For I = 2 To 4

                Cel.Offset(, 1 + I).Interior.Color = CelTrouve.Offset(, I).Interior.Color
                Cel.Offset(, 7 + I).Interior.Color = CelTrouve.Offset(, I).Interior.Color
                Cel.Offset(, 11 + I).Interior.Color = CelTrouve.Offset(, I).Interior.Color
                Cel.Offset(, 16 + I).Interior.Color = CelTrouve.Offset(, I).Interior.Color

            Next I

        End If

    Next Cel

End Sub

Bonjour,

Merci beaucoup pour le code, il fonctionne à merveille.

Je vais pouvoir finir mon suivi.

Merci encore

Bonnes fêtes de fin d'année.

Bonjour,

Je t'en prie c'est avec plaisir et bonne fêtes à toi aussi !