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 48 49
| Sub test()
Dim Tbl()
Dim Plage As Range
Dim Cel As Range
Dim LaDate As Date
Dim Adr As String
Dim I As Integer
'date cherchée (à adapter)
LaDate = #8/31/2011#
'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 cellule G1
Range(Cells(1, 7), Cells(UBound(Tbl, 2), 6 + UBound(Tbl, 1))) _
= Application.WorksheetFunction.Transpose(Tbl())
End Sub |
Partager