Probleme dans une boucle multiple

Version imprimable

Hello everyone,
J'ai encore un challenge pour vous messieurs/dames. Tout d'abord merci à ce site et aux personnes qui y participent. J'ai bcp apris grace à vous...
Voici mon soucis:

J'ai une valeur dans une cellule. C'est du text et c'est un nom. J'ai pour le moment créé une macro qui cherche dans une liste de nom (qui se trouve dans une autre feuille) cette mm valeur. Une fois le nom trouvé, elle me "copie" des données associées à cette valeur dans la feuille originelle. Le pb que je rencontre est que la macro s'arrete à la première fois qu'elle trouve le nom. Disons que dans ma liste de donnée, ce nom apparait 10 fois et la macro ne le trouve qu'une fois. Voici mon code:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 Code : Sub Recherche() Dim i As Integer Dim j As Integer Dim wsB As Worksheet Dim wsK As Worksheet Dim Valeur As String Dim wb As Workbook Dim nbre As Double Set wsB = ThisWorkbook.Worksheets("Graph") Set wsK = ThisWorkbook.Worksheets("A") Valeur = wsB.Range("AliResearch").Value Cb = wsK.Range("Date_de_dénouementA").Column nbre = wsK.Cells(Rows.Count, Cb).End(xlUp).Row If Valeur <> "" Then For i = wsK.Cells.Find("Date1", lookat:=xlWhole).Column To nbre For j = wsB.Cells.Find("Date2", lookat:=xlWhole).Row + 1 To 15 If wsK.Cells(i, 4).Value = Valeur Then wsB.Cells(j, 7).Value = wsK.Cells(i, 2).Value wsB.Cells(j, 8).Value = wsK.Cells(i, 4).Value wsB.Cells(j, 9).Value = wsK.Cells(i, 5).Value wsB.Cells(j, 10).Value = wsK.Cells(i, 7).Value End If Next j Next i End If End Sub
Je ne sais pas si c'est très clair sans le fichier mais je tente le coup.

Aussi, j'ai un autre pb mais peut etre que l'on pourra en discuter après...est il possible de faire la mm recherche avec un nom approximatif?

Merci d'avance

Cordialement

NY

Bonjour,

Il faudrait que tu définisse ta plage de recherche ensuite, tu la parcour avec Find et Findnext à la recherche des noms puis tu défini la ligne ou tu veux coller les données correspondantes en l'incrémentant à chaque occurence du nom. Je te mets un exemple mais je ne me suis pas cassé la tête à recréer ton classeur donc, voilà un début de piste à adapter (pas testé).
Pour la recherche avec une partie du nom en début, tu fait Valeur & "*", pour une partie du nom à la fin tu inverse "*" & Valeur et pour le milieu "*" & Valeur & "*" (voir aussi avec Like) :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 Sub Recherche() Dim wsB As Worksheet Dim wsK As Worksheet Dim Plage As Range Dim Cel As Range Dim Valeur As String Dim Cb As Integer Dim Adr As String Dim J As Integer Valeur = wsB.Range("AliResearch").Value Cb = wsK.Range("Date_de_dénouementA").Column Set Plage = wsK.Range(Cells(1, 1), Cells(Rows.Count, Cb).End(xlUp)) Set Cel = Plage.Find(Valeur & "*", , xlValues) If Not Cel Is Nothing Then Adr = Cel.Address Do 'ici, à partir de la 1ère ligne J = J + 1 wsB.Cells(J, 7).Value = Cel.Offset(0, 2).Value wsB.Cells(J, 8).Value = Cel.Offset(0, 4).Value wsB.Cells(J, 9).Value = Cel.Offset(0, 5).Value wsB.Cells(J, 10).Value = Cel.Offset(0, 7).Value Set Cel = Plage.FindNext(Cel) Loop While Adr <> Cel.Address End If End Sub

08/03/2011, 09h33
NewYork

Merci pour ton retour mais ca n'a pas marché.
Voici un fichier que je viens de refaire pour te montrer mon pb.
J'ai aussi essayé de copier les valeurs dans un array mais je n'ai pas reussi à extraire les données de l'Array.

Cordialement,
NY

Bonjour, New York, Theze,
pour ton fichier exemple :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub Recherche()
Dim plage As Range, vrech As Range, i As Long
Dim wsB As Worksheet   'Worksheet Alize
Dim wsK As Worksheet    'Worksheet Portefeuille
Dim Valeur As String
 
Set wsB = ThisWorkbook.Worksheets("Output")
Set wsK = ThisWorkbook.Worksheets("Data")
 
Valeur = wsB.Range("B2").Value
 
Set plage = wsK.Columns(2)
 
Set vrech = plage.Find(Valeur, after:=wsK.Range("B1"), SearchDirection:=xlNext)
 
wsk.activate
 
With plage
If Not vrech Is Nothing Then
  firstAddress = vrech.Address
      i = 2
        Do
            wsK.Range(Cells(vrech.Row, 1), Cells(vrech.Row, 4)).Copy wsB.Range("G" & i & ":J" & i)
            i = i + 1
            Set vrech = .FindNext(vrech)
        Loop While Not vrech Is Nothing And vrech.Address <> firstAddress
    End If
End With
End Sub

08/03/2011, 11h35
NewYork

!!!!!!!!!!! Super !!!!!!!!! Ca marche super bien !
Je n'aurais jms pu écrire un code pareil ;)...
Merci bcp