Trouver cellule avec même valeur puis copier la couleur de la cellule

Bonjour!
J'ai bien progressé en VBA depuis ma dernière visite ici et j'arrive maintenant à faire quelques macros. Mais pour celle-ci, je ne trouve pas la solution. Voici ce que j'essaie de faire.

Lorsqu'une cellule de la colonne "R" est modifiée, la macro doit chercher une cellule qui contient la même valeur dans la colonne "AA". Si la macro trouve une cellule avec la même valeur dans la colonne "AA", la couleur de fond et le motif de cette cellule dans "AA" est copiée dans la cellule "F" qui se trouve sur la même ligne que la cellule de la colonne "R".
La valeur et la taille de police ne doivent pas être copiées et la valeur de la cellule en F ne doit pas être effacée.

Si la macro ne trouve pas de cellule avec la même valeur, la macro ne fait rien.

Une image vaut mille mots alors j'ai créé un fichier pour bien comprendre le résultat attendu de la macro.

Est-ce que quelqu'un aimerait m'aider? Merci.

16exemple.xlsm (17.18 Ko)

(Pour excel 2007)

Bonjour

Un essai à tester. Te convient-il ?

24exemple-1-v1.xlsm (17.31 Ko)

Bye !

C'est super!
Et moi j'ai passé 20 heures à essayer de faire ça!

J'ai testé et à priori ça fonctionne bien. Demain je vais l'intégrer à mon fichier qui contient d'autres macros et je te confirme s'il n'y a pas de problèmes. Merci gmb!

Finalement j'ai un peu modifié ta macro car j'ai décidé que la recherche serait non pas sur une colonne mais dans une plage de cellules. Et j'ai fait en sorte que la couleur de la cellule de destination soit effacée si aucune correspondance n'est trouvée.

Mais je n'avais pas prévu qu'à la fin la macro sélectionnerait la cellule de la colonne "F". Est-ce que ce serait possible d'empêcher ça? C'est que j'entre beaucoup de données rapidement et c'est assez gênant d'avoir le "curseur" qui se déplace ailleurs.

If Target.Column <> 18 Or Target.Count > 1 Then GoTo suite4a

If Not Intersect(Target, Range("R1:R" & Range("R" & Rows.Count).End(xlUp).Row)) Is Nothing Then

Application.EnableEvents = False

Set cell = Range("AA5:AD12").Find(Target.Value, lookat:=xlWhole)

If Not cell Is Nothing Then

Cells(cell.Row, cell.Column).Copy

Cells(Target.Row, "F").PasteSpecial xlPasteFormats

Else

With Cells(Target.Row, "F").Interior

.Pattern = xlNone

.TintAndShade = 0

.PatternTintAndShade = 0

End With

End If

End If

Application.EnableEvents = True

suite4a:

c'est assez gênant d'avoir le "curseur" qui se déplace ailleurs.

Et où veux-tu que soit la cellule active en fin de macro ?

Bye !

En principe, sur la cellule suivante (en dessous), qui est non masquée, de la colonne "F". Mais finalement, j'ai décidé d'un autre changement dans la structure de ma feuille alors il n'y aura pas de ligne masquée et ce sera simplement la cellule suivante de la colonne "F", et ça, je sais faire!

Donc tout est parfait! Je te remercie pour ton aide! :)

Rechercher des sujets similaires à "trouver meme valeur puis copier couleur"