Option Explicit
Const nfois = 5000
Const Mot = "BRAVO"
Sub Essai()
Dim nbr&, s$, bravo$, xfois&, tablo(), T0
T0 = Timer
Application.ScreenUpdating = False
Randomize
With Worksheets("Test")
.Columns("d:e").Clear
.Cells(1, "d") = "Tirage n°"
.Cells(1, "e") = "Nbr boites jusqu'à " & Mot
xfois = 1
ReDim tablo(1 To nfois, 1 To 2)
Do While xfois <= nfois
bravo = Mot: nbr = 0
Do While bravo <> ""
nbr = nbr + 1
s = Chr(CInt(Rnd * 26 + 65))
If InStr(bravo, s) > 0 Then
bravo = Replace(bravo, s, "", 1, 1)
End If
Loop
tablo(xfois, 1) = xfois
tablo(xfois, 2) = nbr
xfois = xfois + 1
Loop
.Cells(2, "d").Resize(nfois, 2) = tablo
Application.ScreenUpdating = True
MsgBox "Durée = " & Format(Timer - T0, "#,##0.00") & " sec."
End With
End Sub