XL 2016 VBA Copie de donnée en fonction d'une condition

[AntonG]

Bonjour à tous,

J'ai besoin de votre aide, je souhaiterais (sur le fichier que je vous mets ci-joints) que des données soient transférer de la feuil1 vers la feuil2 selon une condition.

Dans la première feuille en A se trouve une combinaison d'un numéro d'article (repris de la colonne C) et du chapitre dans lequel l'article se trouve (donnée reprise en colonne B qui provient de la colonne K du ruban jaune.

Dans la deuxième feuille il s'agit d'un comparatif, on y retrouves les articles.

Quand les codes sont en verts c'est que les premières macros ont trouvé des correspondance et rouge qu'elles n'ont pas trouvée de correspondance.

Ce que j'aimerais faire :

Pour les cellules qui ont du texte et sont de couleur de fond vert dans la colonne A de la feuil2 chercher la correspondance en feuil1 colonne A.

Si une correspondance est trouvée copier la valeur qui est en colonne E de ce qu'il a trouvé et la coller en feuil2 dans la colonne n de l'article qui était recherché.

Si aucune correspondance, ne rien faire est passer à la cellule verte suivante.

J'ai un début de code pour la recherche du vert mais pas pour la récupération des valeurs.

Je sais qu'il serait possible de le faire par formules, mais je souhaite éviter qu'il y ait des formules.

J'ai du enlever des lignes pour pouvoir vous envoyer le fichier, mais normalement il y a plus de 22'000 lignes.

N'hésitez pas à demander plus d'explications si ce n'est pas clair

En vous remerciant par avance pour votre aide !

 

[AntonG]

Finalement, après quelques recherches et tests complémentaires, j'ai réussi à créer ce code qui marche pour ce que je voulais faire

Sub TEST()
'
' Copie les données de l'extraction si l'article est trouvé
Application.ScreenUpdating = False
Application.PrintCommunication = False
For Each n In Feuil4.Range("A:A")
If n.Value <> "" Then ' n'applique qu'aux cellules avec du texte
Set c = Feuil3.Range("A:A").Find(n.Cells.Value, LookIn:=xlValues, lookat:=xlWhole) ' Recherches une correspondance
If Not c Is Nothing Then ' quand il trouve une correspondance
n.Cells.Offset(0, 3).Value = c.Cells.Offset(0, 2).Value ' Reprends la valeur
Set c = Nothing
End If
End If
Next
MsgBox "Fin"
Application.PrintCommunication = True
Application.ScreenUpdating = True
End Sub