Création d'une macro de recherche dans une table

[drareg78]

Bonjour aux membres du forum.

Je cherche désespérément à créer une macro qui permettrait, après recherche dans une table en feuil1, de créer une liste en fonction d'un critère, et recopier celle ci en feuil2. Pour plus de clarté, je vous joint mon fichier exemple.

Meci de votre aide

 

[bqtr]

Re : Création d'une macro de recherche dans une table

Bonjour drareg78,

Ceci semble correspondre à ta demande :

Sub Automatique()
Dim TabloD, TabloA(), k As Long, y As Long
TabloD = Sheets("Feuil1").Range("A9:C" & Sheets("Feuil1").Range("A65536").End(xlUp).Row)
For k = LBound(TabloD, 1) To UBound(TabloD, 1)
   If TabloD(k, 3) = UCase("X") Then
       ReDim Preserve TabloA(2, 0 To y)
       TabloA(0, y) = TabloD(k, 1)
       TabloA(1, y) = TabloD(k, 2)
       TabloA(2, y) = TabloD(k, 3)
       y = y + 1
   End If
Next
With Sheets("Feuil2")
   .Range("B7:B" & .Range("B65536").End(xlUp).Row).ClearContents
   For k = LBound(TabloA, 2) To UBound(TabloA, 2)
     .Cells(k + 7, 2) = TabloA(0, k)
   Next
End With
End Sub

Bonne journée
A+

 

[drareg78]

Re : Création d'une macro de recherche dans une table

Bonjour drareg78,

Ceci semble correspondre à ta demande :

Sub Automatique()
Dim TabloD, TabloA(), k As Long, y As Long
TabloD = Sheets("Feuil1").Range("A9:C" & Sheets("Feuil1").Range("A65536").End(xlUp).Row)
For k = LBound(TabloD, 1) To UBound(TabloD, 1)
   If TabloD(k, 3) = UCase("X") Then
       ReDim Preserve TabloA(2, 0 To y)
       TabloA(0, y) = TabloD(k, 1)
       TabloA(1, y) = TabloD(k, 2)
       TabloA(2, y) = TabloD(k, 3)
       y = y + 1
   End If
Next
With Sheets("Feuil2")
   .Range("B7:B" & .Range("B65536").End(xlUp).Row).ClearContents
   For k = LBound(TabloA, 2) To UBound(TabloA, 2)
     .Cells(k + 7, 2) = TabloA(0, k)
   Next
End With
End Sub

Bonne journée
A+

Merci bqtr c'est exactement ce que je cherchais. Je dois maintenant m'atteler à la compréhension de ta macro et là c'est pas gagné.

Merci encore