Sub Tirage()
Dim N As Byte, NF As Byte, d As Object, i As Byte, tablo, j As Byte
Application.ScreenUpdating = False
Randomize
[E2:E65534].ClearContents
[A:D].Sort [D1], xlAscending, , [C1], xlAscending, Header:=xlYes 'tri, femmes en tête
N = Application.CountIf([D:D], "P") 'nombre de participants
NF = Application.CountIf([C:C], "F") 'nombre de femmes
1 Set d = CreateObject("Scripting.Dictionary")
While d.Count < N
i = Int((N * Rnd) + 1)
d(i) = i
Wend
[E2].Resize(N) = Application.Transpose(d.items) 'transcription dans la feuille
tablo = [E2].Resize(NF)
For i = 1 To NF - 1 'analyse des écarts
For j = i + 1 To NF
If Abs(tablo(i, 1) - tablo(j, 1)) < 3 Then GoTo 1
Next
Next
End Sub