VBA: sélection de lignes répondant à la même valeur

Bonjour,


Je désire sélectionner les lignes répondant à la même valeur (sélectionner par exemple toutes les lignes correspondant au numéro 1234 mais sans spécifier le numéro car des numéros peuvent s'ajouter au tableau à chaque fois)
Les lignes sélectionnées devront copier une nouvelle feuille.

exemple tableau


Numéro type référence
1234 actions 1111
1234 actions 1111
1234 Obligations 1234
1234 Obligations 1234
2222 Obligations 1234
2222 Obligations 1234
2222 Obligations 1234
3333 Obligations 1234
3333 Obligations 1234


Résulat désiré par exemple pour le numéro 1234:

Numéro type référence
1234 actions 1111
1234 actions 1111
1234 Obligations 1234
1234 Obligations 1234


J'ai créé le code suivant:
Sub test()

' COPIE DES LIGNES DESIREES DANS LES FEUILLES DE CALCUL DEDIEES

Dim Rw As Range
Dim Ligne As Long
Dim derli
Dim z
Dim cell


Dim r

' Sélectionne l'ensemble des données (utile pour qu'Excel ne "réfléchisse" pas sur les 65000 lignes)

Sheets("données").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range(Selection, Cells(1)).Select


' Boucle qui va passer sur chaque ligne de la sélection afin de déterminer si des lignes contiennent le flag voulu
' puis copie dans une deuxième feuille de calcul

For Each Rw In Selection.Rows
Ligne = Rw.Row



If Rw.Cells(1, 1).Value = "1234" Then

Rw.Copy Destination:=Worksheets("client2").Cells(Ligne, 1).EntireRow

End If

Next Rw

' Boucle qui va passer sur chaque ligne de la sélection afin de déterminer si des lignes contiennent le flag voulu
' puis copie dans une troisième feuille de calcul

For Each Rw In Selection.Rows

Ligne = Rw.Row

If Rw.Cells(1, 1).Value = "2222" Then
Rw.Copy Destination:=Worksheets("client1").Cells(Ligne, 1).EntireRow
End If

Next Rw

' Boucle qui va passer sur chaque ligne de la sélection afin de déterminer si des lignes contiennent le flag voulu
' puis copie dans une troisième feuille de calcul

For Each Rw In Selection.Rows

Ligne = Rw.Row

If Rw.Cells(1, 1).Value = "3333" Then
Rw.Copy Destination:=Worksheets("client1").Cells(Ligne, 1).EntireRow
End If

Next Rw

' Supression des lignes vierges dans les feuilles de calcul récemment constituées

Sheets("client1").Activate

With ActiveSheet.UsedRange
derli = .Row + .Rows.Count - 1
End With
Application.ScreenUpdating = False
For r = derli To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r



Application.StatusBar = "- 20% - Macro en cours d'exécution, merci de patienter."

Sheets("client2").Activate

With ActiveSheet.UsedRange
derli = .Row + .Rows.Count - 1
End With
Application.ScreenUpdating = False
For r = derli To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r


End Sub


mais avec ce code il faut tjs spécifier la valeur à sélectionner!!

svp j'ai besoin de votre aide.