Discussion :

[spico45]

Bonjour à tous,

J'aimerais pouvoir récuperer et copier toutes les lignes qui sont lié à une donnée. Je n'arrive qu' à récuperer une ligne mais pas plus.
Par exemple : j'ai une pièce nommé X et j'ai pour cette pièces 6 lignes de données. Je voudrais pouvoir récupérer quand je cherhce X voir les 6 lignes qui s'affichent.

J'ai mis mon tableau excel pour exemple avec plus d'explication.

Merci de votre aide

[mercatog]

Bonjour,
pour un premier post, lire ceci: http://www.developpez.net/forums/d84...s-discussions/
mais pour cette fois, j'ai adapté ton code à tes feuilles de données:

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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim typ As String, tot As String
Dim c As Range, v As Range
Dim ligDeb As Long, LigFin As Long
Dim ws As Worksheet
 
On Error GoTo Fin
Set ws = Sheets("" & Range("c2").Value & "")
Application.EnableEvents = False
Range("C5:C" & Range("C5").End(xlDown).Row).ClearContents
 
If Not Intersect(Target, Range("c2:c3")) Is Nothing Then
    If Range("c2").Value <> "" And Range("c3").Value <> "" Then
        typ = "pc " & Range("c3").Value
        tot = "TOTAL " & UCase(Range("c3").Value)
 
        Set c = ws.Columns("A:A").Find(typ, LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
            ligDeb = c.Row
            Set v = ws.Columns("A:B").Find(tot, LookIn:=xlValues, lookat:=xlPart)
                If Not v Is Nothing Then
                    LigFin = v.Row - 1
                    ws.Range("B" & ligDeb & ":B" & LigFin).Copy Range("C5")
                Else
                    MsgBox "Erreur de données"
                End If
            Set v = Nothing
        End If
        Set c = Nothing
    End If
End If
 
Fin:
Application.EnableEvents = True
Set ws = Nothing
End Sub

[spico45]

Merci,

j'ai lu le post après avoir posté et je m'en excuse.
Je n'ai pas encore essayé ton code mais merci par avance.

Après avoir essayé, j'ai rencontré un problème si j'ecris n'importe où sur la feuil1 tout ce qui apparait s'efface. Et je ne trouve pas l'erreur.

[mercatog]

Bonsoir,
désolé, erreur de placement
ci joint modification

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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim typ As String, tot As String
Dim c As Range, v As Range
Dim ligDeb As Long, LigFin As Long
Dim ws As Worksheet
 
On Error GoTo Fin
Set ws = Sheets("" & Range("c2").Value & "")
 
If Not Intersect(Target, Range("c2:c3")) Is Nothing Then
    Application.EnableEvents = False
    Range("C5:C" & Range("C5").End(xlDown).Row).ClearContents
    If Range("c2").Value <> "" And Range("c3").Value <> "" Then
        typ = "pc " & Range("c3").Value
        tot = "TOTAL " & UCase(Range("c3").Value)
 
        Set c = ws.Columns("A:A").Find(typ, LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
            ligDeb = c.Row
            Set v = ws.Columns("A:B").Find(tot, LookIn:=xlValues, lookat:=xlPart)
                If Not v Is Nothing Then
                    LigFin = v.Row - 1
                    ws.Range("B" & ligDeb & ":B" & LigFin).Copy Range("C5")
                Else
                    MsgBox "Erreur de données"
                End If
            Set v = Nothing
        End If
        Set c = Nothing
    End If
End If
 
Fin:
Application.EnableEvents = True
Set ws = Nothing
End Sub

[spico45]

Ma deuxième question est la suivante:

une fois que les phrases sont apparues, j'écris mes valeurs à coté et je voudrais qu'il aille se copier dans les cases vides correspondantes.

Merci

cordialement