Rechrche verticale avec plusieurs valeurs

[Norty7]

Hello forum,

J'ai trouvé un code qui permet de faire une recherchev dans la colonne A de la feuille "Feuil1" pour en rappatrier plusieurs valeurs vers la feuille "MESSAGES-OK".

Dans Feuil1 j'ai:
ColA ColB
1 A
1 A
2 B
2 B
3 C
4 D

Dans "MESSAGES-OK" je rappatrie:
ColA ColB ColC ColD
1 A A
2 B B
3 C
4 D

Et là, il a sauté la colonne B.

Question:Comment faire pour avoir en "MESSAGES-OK"
ColA ColB
1 A,A
2 B,B
3 C
4 D

Voici le code:

Sub options()
Dim Model As String
Dim cells1, cells2 As Range
Dim i
For Each cells1 In Worksheets("MESSAGES-OK").Range("A1:A" & Worksheets("MESSAGES-OK").Range("A65536").End(xlUp).Row)
Model = cells1.Value
i = 2
For Each cells2 In Worksheets("Feuil1").Range("A1:A" & Worksheets("Feuil1").Range("A65536").End(xlUp).Row)
If cells2.Value = Model Then
cells1.Offset(0, i) = cells2.Offset(0, 1).Value
i = i + 1
End If
Next
Next
End Sub

D'avance merci de votre aide.

 

[Odesta]

Re : Rechrche verticale avec plusieurs valeurs

Bonjour

le décalage de deux est provoqué par le i = 2.

est-ce que i=1 fonctionne mieux ?

Pour plus d'aide, merci de joindre un fichier exemple, c'est plus agréable que de copier/collé

Olivier

 

[Norty7]

Re : Rechrche verticale avec plusieurs valeurs

Bonjour Odesta,

Effectivement c'était ca...merci

Sans vouloir abuser, est il possible de rapptrier les valeurs et les séparer par une virgule quand elles sont multiples??? je mets mon fichier en PJ.

Encore merci.

 

[Odesta]

Re : Rechrche verticale avec plusieurs valeurs

Hop :

Sub options()
Dim Model As String
Dim cells1, cells2 As Range
Dim nb
For Each cells1 In Worksheets("MESSAGES-OK").Range("A1:A" & Worksheets("MESSAGES-OK").Range("A65536").End(xlUp).Row)
Model = cells1.Value
nb = 0
For Each cells2 In Worksheets("Feuil1").Range("A1:A" & Worksheets("Feuil1").Range("A65536").End(xlUp).Row)
If cells2.Value = Model Then
    nb = nb + 1
    If nb = 1 Then
        cells1.Offset(0, 1).Value = cells2.Offset(0, 1).Value
    Else
        cells1.Offset(0, 1).Value = cells1.Offset(0, 1).Value & ", " & cells2.Offset(0, 1).Value
    End If
End If
Next
Next
End Sub

Olivier

 

[Norty7]

Re : Rechrche verticale avec plusieurs valeurs

Yessssssssssss

Trop génial.

Merci M'sieur