Sub tirage()
Dim dico, Nb As Long, Tablo, Azard As Double, i As Long
Nb = Range("F5").Value
Set dico = CreateObject("Scripting.Dictionary")
Do Until dico.Count >= Nb
Tablo = Range("A2:A" & Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row).Value
Randomize
Azard = Int(Rnd() * (UBound(Tablo, 1)) + 1)
dico(Tablo(Azard, 1)) = Tablo(Azard, 1)
Loop
Tablo = dico.keys
Range("O1").Value = "id"
Range("H2:O65536").ClearContents
For i = 0 To UBound(Tablo)
Range("O" & i + 2).Value = Tablo(i)
Next i
Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"O1").CurrentRegion, CopyToRange:=Range("H1:K1"), Unique:=False
Range("O1").EntireColumn.ClearContents
End Sub