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 38 39 40 41 42 43 44 45 46 47
| Dim Plage As Range
Dim Cel As Range
Dim LaDate As Date
Dim Adr As String
Dim I As Integer
Dim L As Long
'la date cherchée est celle choisie dans la ListBox
'(Contrôle ActiveX située dans la Feuil1)
'Nom dans le VBE = Feuil1
With Userselection.ListBox2
'si pas de choix, message et fin
If .ListIndex = -1 Then
MsgBox "Vous devez faire un choix !"
Exit Sub
End If
LaDate = .List(.ListIndex)
End With
'plage où s'effectue la recherche de date (colonne A)
Set Plage = Range([T1], [T65536].End(xlUp))
'recherche la date
Set Cel = Plage.Find(LaDate, , xlValues, xlWhole)
'si trouvé
If Not Cel Is Nothing Then
'mémorise l'adresse de la 1ère cellule
Adr = Cel.Address
'boucle pour récupérer toutes les dates
'et stocke les valeurs des colonnes A à D
'dans un tableau
Do
I = I + 1
ReDim Preserve Tbl(1 To 6, 1 To I)
Tbl(1, I) = Cel
Tbl(2, I) = Cel.Offset(0, 1)
Tbl(3, I) = Cel.Offset(0, 2)
Tbl(4, I) = Cel.Offset(0, 3)
Tbl(5, I) = Cel.Offset(0, 4)
Tbl(6, I) = Cel.Offset(0, 5)
Set Cel = Plage.FindNext(Cel)
Loop While Adr <> Cel.Address
End If
'colle le résultat à partir de la première cellule vide en colonne A feuil2
Worksheets("Feuil2").Activate
If [A65536].End(xlUp).Row = 1 Then L = 1 Else L = [A65536].End(xlUp).Row + 1
Range(Cells(L, 7), Cells(L + UBound(Tbl, 2) - 1, 6 + UBound(Tbl, 1))) _
= Application.WorksheetFunction.Transpose(Tbl())
Worksheets("Feuil1").Activate |
Partager