Sub Tirages()
Dim a, d As Object, decal&, col%, ligmax&, n%, nn%, c As Range, im&, i&, lig&
a = Array([F3:G3,M3], [H3:I3,M3], [J3:L3,M3])
Set d = CreateObject("Scripting.Dictionary")
decal = 3 'les résultats sont décalés de 3 lignes
Randomize
Application.ScreenUpdating = False
For col = 1 To UBound(a) + 1 'numéro de la colonne source
d.RemoveAll 'RAZ
ligmax = Application.CountA(Columns(col)) 'il ne faut pas de cellules vides...
n = 0
nn = a(col - 1).Count
For Each c In a(col - 1)
n = n + 1
If n < nn Or im = 0 Then c(decal + 1).Resize(Rows.Count - c.Row - decal + 1).ClearContents 'RAZ de la colonne
For i = IIf(n = nn, im + 1, 1) To Val(c)
If d.Count = ligmax - 1 Then Exit For
Do
lig = Application.RandBetween(2, ligmax) 'nombre entier aléatoire
Loop While d.exists(lig)
d(lig) = ""
c(decal + i) = Cells(lig, col) 'restitution
If n = nn Then im = i 'mémorise la ligne
Next i, c, col
End Sub