Sub tutu()
Dim n As Integer, p As Long
Dim Mem As Integer
Dim Pic As Integer
Randomize
Pic = 0
Do
Mem = 0: p = 0
Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).Resize(1, 2) = Array(n, Timer)
Do: n = 0: p = p + 1: Do While Int(6 * Rnd): n = n + 1: Loop
DoEvents:
Application.StatusBar = n & " " & p
If n > Mem Then
Mem = n
Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).Resize(1, 3) = Array(n, Timer, p)
End If
Loop While n < Pic
Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).Resize(1, 4).Value = Array(n, Timer, p, Pic)
Pic = Pic + 1
Loop Until Pic = 85
End Sub