Discussion :

[NewYork]

Bonjour à ts,

J'avais deja posté une discussion sur le sujet. J'ajoute ici un fichier. Mon but est d'afficher toutes les valeurs existantes pour le nom entré en B2...
Pouvez vous m'indiquer ou je me trompe. Je sais que c'est bete mais je bloque dessus depuis plusieurs jours deja.

Merci d'avance,

PS:J'ai aussi essaye des Arrays mais je n'arrive pas a recopier les données.

[JPierreM]

Bonjour,

En utilisant votre code sans chercher à optimiser

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
Sub Recherche()
 
Dim i As Integer
Dim J As Integer
Dim wsB As Worksheet   'Worksheet Alize
Dim wsK As Worksheet    'Worksheet Portefeuille
Dim Valeur As String
Dim wb As Workbook
Dim nbre As Double
 
Set wsB = ThisWorkbook.Worksheets("Output")
Set wsK = ThisWorkbook.Worksheets("Data")
Valeur = wsB.Range("B2").Value
 
Cb = wsK.Range("Date").Column
nbre = wsK.Cells(Rows.Count, Cb).End(xlUp).Row
J = 2
If Valeur <> "" Then
    For i = 2 To nbre 'wsK.Cells.Find("Date A ", lookat:=xlWhole).Row + 1 To nbre
        'For J = wsB.Cells.Find("Date E", lookat:=xlWhole).Row + 1 To 20
 
            If wsK.Cells(i, 2).Value = Valeur Then
 
                    wsB.Cells(J, 7).Value = wsK.Cells(i, 1).Value
                    wsB.Cells(J, 8).Value = wsK.Cells(i, 2).Value
                    wsB.Cells(J, 9).Value = wsK.Cells(i, 3).Value
                    wsB.Cells(J, 10).Value = wsK.Cells(i, 4).Value
                J = J + 1
            End If
        'Next J
    'J = J + 1
    Next i
i = i + 1
End If
 
 
End Sub

[Michel_M]

Bonjour,

une autre manière de rechercher:

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
Sub Recherche()
 
Dim wsB As Worksheet   'Worksheet Alize
Dim wsK As Worksheet    'Worksheet Portefeuille
Dim Valeur As String
 
Dim nbre As Long, cptr As Long
Dim lig As Byte
Dim T_out
 
Set wsB = ThisWorkbook.Worksheets("Output")
Set wsK = ThisWorkbook.Worksheets("Data")
Valeur = wsB.Range("B2").Value
 
With wsK
    nbre = Application.CountIf(.Columns(2), Valeur)
    If nbre > 0 Then
        ReDim T_out(1 To nbre, 1 To 4)
        lig = 1
        For cptr = 1 To nbre
                lig = .Columns(2).Find(Valeur, .Cells(lig, 2), xlValues).Row
                   T_out(cptr, 1) = .Cells(lig, 1).Value
                    T_out(cptr, 2) = .Cells(lig, 2).Value
                    T_out(cptr, 3) = .Cells(lig, 3).Value
                    T_out(cptr, 4) = .Cells(lig, 4).Value
        Next
    End If
End With
 
Application.ScreenUpdating = False
With wsB
    .Range("G2:J1000").ClearContents
    .Range("G2").Resize(cptr - 1, 4) = T_out
End With
 
End Sub

[NewYork]

Merci pour cette réponse !

Cordialement, NY