RECHERCHEV plusieurs données VBA

Bonjour à tous,

Je dispose d'un fichier xlsm avec deux onglets : sheet1 et sheet2. Dans l'onglet sheet1 j'ai un tableau qui se schématise un peu de la façon suivante :

A	B	...	H (colonne)
1			Alain
1			Pierre
1			Alain
2			Fabrice
2			Stéphanie
2			Stéphanie
3			Paul

L'onglet Sheet2

A	B	C	D
1
1
1		Responsable
1		Responsable
1		Responsable
1
2
2
2		Responsable
2		Responsable
2		Responsable
2
3
3
3		Responsable
3

Je souhaiterais voir apparaître, par ordre chrono, dans la colonne D de sheet2 les noms qui sont initialement décrits en colonne H de sheet1 uniquement pour les lignes où il y a écrit "responsable" en colonne C en sheet2.

Je ne demande pas forcément un code complet clé en main mais aussi des pistes de ce qui pourrait être mis en place car je sèche un peu depuis hier...

Merci beaucoup.

Bonjour
si j'ai bien compris

Pièce jointe 509810

voir la formule en D3

Code:

---

=SI(B3="Responsable";Feuil1!B3;"")

---

Merci pour ton retour.

Ce n'est pas vraiment ça. Pour être plus clair, je mets un fichier en pièce jointe où tu trouveras l'architecture du fichier que j'utilise. Je souhaiterais avoir les noms en rouge dans les cellules en jaune du deuxième onglet.

Le fichier est ici : Pièce jointe 509817

Si c'est plus clair...

J'essaie d'imbriquer de FindNext pour arriver à mes fins sans succès pour le moment :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18

Set Investig = Worksheets(name2).Columns(ActLead).Find("Responsable investigation") If Not Investig Is Nothing Then FirstAddress = Investig.Address InvestigName1 = Investig.Row Set InvestId = Worksheets(name1).Columns(EventColumnid).Find(Cells(InvestigName1, 1).Value) InvestIdRow = InvestId.Row Do Cells(InvestigName1, InvestName).Value = .Cells(InvestIdRow, InvestigName).Value Set Investig = Worksheets(name2).Columns(ActLead).FindNext(Investig) If Investig Is Nothing Then GoTo DoneFinding End If InvestigName1 = Investig.Row Set InvestId = Worksheets(name1).Columns(EventColumnid).FindNext(InvestId) InvestIdRow = InvestId.Row Loop While Investig.Address <> FirstAddress End If DoneFinding:

---

Merci à tous pour votre aide.

Bonjour,
je ne suis pas assez calé pour ce type de code,
j'essayerai de regarder ce Week-end.

Bonjour,

Lors de votre première demande, si vous pouviez fournir les éléments identiques au fichier déposé par la suite, cela éviterait des pertes de temps et que des personnes prêtes à vous aider ne le fasse pas pour rien.

le code d'après le fichier déposé et non par rapport à la demande initiale.

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

Sub Recup_Valeurs() Dim f1 As Worksheet, f2 As Worksheet Dim DerLig_f1 As Long, DerLig_f2 As Long Dim x As Object Dim i As Long Application.ScreenUpdating = False Set f1 = Sheets("Suivi") Set f2 = Sheets("Extraction") f1.Columns("c").ClearContents DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row Evenement = "" For i = 2 To DerLig_f1 If f1.Cells(i, "B") = "Investigation" Then If f1.Cells(i, "A") <> Evenement Then LigDeb_f2 = 1 Evenement = f1.Cells(i, "A") Set x = f2.Range(f2.Cells(LigDeb_f2, "A"), f2.Cells(DerLig_f2, "A")).Find(Evenement, LookIn:=xlValues, lookat:=xlWhole) If Not x Is Nothing Then f1.Cells(i, "C") = f2.Cells(x.Row, "B") LigDeb_f2 = x.Row End If End If Next i Set f1 = Nothing Set f2 = Nothing Set x = Nothing End Sub

---

Cdlt