extraction après recherche dans tableau

Bonjour.
Le classeur suivant :
http://cjoint.com/?gsnES1Wihp
contient 3 feuilles :
- Tableau : contient la liste des noms à chercher
- Source : contient la liste à chercher
- Cible : feuille recevant les lignes sélectionnées.

La macro suivante recherche chaque élément du tableau dans la feuille
"Source" et copie la ligne dans la feuille cible. Note que si une ligne
comporte plusieurs éléments du tableau, elle recopiée autaant de fois.

Sub test()
Dim c As Range, ResAdr As String, Plage As Range, Cel As Range
Dim Ligne As Long
Ligne = 1
With Sheets("Tableau")
Set Plage = .Range("A1", .Range("A65536").End(xlUp))
End With
For Each c In Plage
Set Cel = Sheets("Source").UsedRange.Find(c, , , xlWhole)
If Not Cel Is Nothing Then
ResAdr = Cel.Address
Do
Cel.EntireRow.Copy Sheets("Cible").Cells(Ligne, 1)
Ligne = Ligne + 1
Set Cel = Sheets("source").UsedRange.FindNext(Cel)
Loop While Not Cel Is Nothing And Cel.Address <> ResAdr
End If
Next c
End Sub

Cordialement.
Daniel
"jcc0127" <jcc0127@gmail.com> a écrit dans le message de news:
1182159770.720208.127290@o61g2000hsh.googlegroups.com...
Bonjour à tous,

Je débute en VBA et je voudrais copier-coller des lignes complètes
lorsque celles-ci contiennent une des valeurs d'un tableau !!
Comment faire, svp ?

Merci d'avance pour votre aide !

Jean-Christophe

Merci beaucoup Daniel !!

C'est tout à fait ce qu'il me fallait !!!

Impeccable !

A+
Jean-Christophe


On 18 juin, 13:35, "Daniel" <dZZZcolarde...@free.fr> wrote:

Bonjour.
Le classeur suivant :http://cjoint.com/?gsnES1Wihp
contient 3 feuilles :
- Tableau : contient la liste des noms à chercher
- Source : contient la liste à chercher
- Cible : feuille recevant les lignes sélectionnées.

La macro suivante recherche chaque élément du tableau dans la feuille
"Source" et copie la ligne dans la feuille cible. Note que si une ligne
comporte plusieurs éléments du tableau, elle recopiée autaant de fo is.

Sub test()
Dim c As Range, ResAdr As String, Plage As Range, Cel As Range
Dim Ligne As Long
Ligne = 1
With Sheets("Tableau")
Set Plage = .Range("A1", .Range("A65536").End(xlUp))
End With
For Each c In Plage
Set Cel = Sheets("Source").UsedRange.Find(c, , , xlWhole)
If Not Cel Is Nothing Then
ResAdr = Cel.Address
Do
Cel.EntireRow.Copy Sheets("Cible").Cells(Ligne, 1)
Ligne = Ligne + 1
Set Cel = Sheets("source").UsedRange.FindNext(Cel)
Loop While Not Cel Is Nothing And Cel.Address <> ResAdr
End If
Next c
End Sub

Cordialement.
Daniel
"jcc0127" <jcc0...@gmail.com> a écrit dans le message de news:
1182159770.720208.127...@o61g2000hsh.googlegroups.com...
Bonjour à tous,

Je débute en VBA et je voudrais copier-coller des lignes complètes
lorsque celles-ci contiennent une des valeurs d'un tableau !!
Comment faire, svp ?

Merci d'avance pour votre aide !

Jean-Christophe