Sub Test()
Dim melange As New Collection
Dim tmp As New Collection
Dim i%, j%, k%, x%
If Selection.Cells.Count > 1 Then
On Error GoTo GESTERR
For Each o In Selection
melange.Add o.Value
tmp.Add o.Value
Next
k = melange.Count
Kmem = k
Do While k > 0
If k > 0 Then
j = j + 1
Do
i = Int((k * Rnd) + 1)
x = melange(i)
Y = tmp(j) = x
If Y And j = Kmem Then Err.Raise 65535
Loop While Y
Cells(j, 2) = x
melange.Remove i
k = k - 1
End If
Loop
Else
MsgBox 'Vous devez sélectionner au moins' & Chr(10) & _
'2 cellules contenant des integer !'
End If
Exit Sub
GESTERR:
Test
End Sub