Tirage Aléatoire de valeurs dans un tableau

Sub TirageAlé_a()
Dim DateDéb As Date, DateFin As Date, DateTirée As Date, LDéb As Long, LFin As Long, Le As Long, Ls As Long, i As Long
Dim coll As New Collection
Feuil2.Cells.ClearContents
DateDéb = CDate(InputBox("Date mini", "TirageAlé"))
DateFin = CDate(InputBox("Date maxi", "TirageAlé"))
LDéb = 2: LFin = Feuil1.Cells(Feuil1.Rows.Count, "A").End(xlUp).Row
i = 1
Randomize
'Do Until i = 200
While coll.Count < 200
Le = LDéb + Int(Rnd * (LFin - LDéb + 1))
If Feuil1.Cells(Le, "B").Value <> "" Then
DateTirée = CDate(Feuil1.Cells(Le, "B").Value)
If DateTirée >= DateDéb And DateTirée <= DateFin Then
On Error Resume Next
coll.Add DateTirée
On Error GoTo 0
Feuil2.Cells(i, "A").NumberFormat = Feuil1.Cells(Le, "A").NumberFormat
Feuil2.Cells(i, "A").Value = Feuil1.Cells(Le, "A").Value
Feuil2.Cells(i, "B").Value = Feuil1.Cells(Le, "B").Value
Feuil2.Cells(i, "C").Value = Feuil1.Cells(Le, "C").Value: Feuil1.Cells(Le, "C").ClearContents
Feuil1.Cells(Le, "D").Value = "Selectionnée"
i = i + 1
End If
End If
Wend
'Loop
End Sub

i = i + 1

If i > 1000 Then
  MsgBox ("1000 tirages effectués sans avoir atteint 200 resultats ")
  Exit Sub
End If

End If

Sub TirageAlé()
Dim DateDéb As Date, DateFin As Date, DateTirée As Date, LDéb As Long, LFin As Long, Le As Long, Ls As Long, NTnt As Long
DateDéb = CDate(InputBox("Date mini", "TirageAlé"))
DateFin = CDate(InputBox("Date maxi", "TirageAlé"))
LDéb = 2: LFin = Feuil1.[A65536].End(xlUp).Row
Randomize
For Ls = 1 To 200
   NTnt = 0
   Do
      If NTnt >= 100000 Then MsgBox NTnt & " tentatives infructueuses d'obtenir le tirage ligne " _
         & Ls & ". ==> Abandon", vbCritical + vbExclamation, "TirageAlé": Exit Sub
      Le = LDéb + Int(Rnd * (LFin - LDéb + 1))
      If Feuil1.Cells(Le, "C").Value <> "" Then
         DateTirée = CDate(Feuil1.Cells(Le, "B").Value)
         If DateTirée >= DateDéb And DateTirée <= DateFin Then Exit Do
         End If
      NTnt = NTnt + 1: Loop
   Feuil2.Cells(Ls, "A").NumberFormat = Feuil1.Cells(Le, "A").NumberFormat
   Feuil2.Cells(Ls, "A").Value = Feuil1.Cells(Le, "A").Value
   Feuil2.Cells(Ls, "B").Value = Feuil1.Cells(Le, "B").Value
   Feuil2.Cells(Ls, "C").Value = Feuil1.Cells(Le, "C").Value: Feuil1.Cells(Le, "C").ClearContents
   Feuil1.Cells(Le, "D").Value = "Selectionnée"
   Next Ls
End Sub