Cher Tous,

Je pensais trouver seule mais non je tourne en rond...alors HEEEELLLLLP! Toute jeune débutante en vba (1 semaine) et sur le forum également.
Alors un grand merci par avance pour votre aide.

Je tente de récupérer des données en fonction d'une clé de recherche avec la méthode findnext et ÔÔÔ surprise je n'arrive à remonter que la première et la dernière valeur.

Mon fichier est ainsi constitué : feuille (constitution) où je souhaite lire les informations remontées, feuille ( fond, cellule E5) où se trouve l'élément recherché et enfin la feuille3 (base) où se trouve ma base de donnée.
Mon objectif était de rechercher la clé E5 dans la colonne A de la feuille base et de remonter toutes les valeurs correspondantes et situées en colonne B dans la feuille consultation.
Mon code semble bien lire la feuille base dans son entier mais malheureusement ne me remonte que deux valeurs, la première et la derniere.
En fonction de l'endroit où j'écris mon offset il me remonte parfois la première valeur parfois la seconde valeurs. je pense avoir mal codé le offset pour lui permettre de copier et coller toutes les informations correspondant à la valeur E5.

Y aurait il quelqu'un pour m'aider... ?????

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Sub recherche10()
 
'declaration des variables
Dim wb As Workbook
Dim wsdata As Worksheet, wsrecherche As Worksheet, wsconsultation As Worksheet
Dim cle_destination As Range, c As Range
Dim contrat As Range, cle_origine As Range
Dim derAddress As String
 
 
'initialiser les variables
Set wb = ThisWorkbook
Set wsdata = wb.Sheets("base")
Set wsrecherche = wb.Sheets("fond")
Set wsconsultation = wb.Sheets("Consultation")
Set contrat = wsdata.Range("A1 :A19006")
Set cle_origine = wsrecherche.Range("E5")
 
'rechercher
 
With wsdata
 
Set c = contrat.Find(what:=cle_origine, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    For Each cle_origine In contrat
 If c.Value = cle_origine.Value Then
 c.Offset(0, 1).Copy destination:=wsconsultation.Range("B8")
 
            If Not (c Is Nothing) Then
derAddress = c.Address
Do
Set c = contrat.FindNext(c)
Loop While c.Address <> derAddress
 
End If
End If
Next
End With
End Sub