Sub tire()
Dim h&, i&, j&, k&, u() As Variant, v&(), w() As Variant
Dim Origine As Range, Destination As Range, nbCol&
' === Paramètres =======================================
Set Origine = Me.Range("A1").Cells: nbCol = 4
Set Destination = Me.Range("H1").Cells
k = Me.Range("F5").Value
' ======================================================
With Origine
u = .Parent.Range(.Cells, .Parent.Cells(.Parent.Rows.Count, .Column).End(xlUp).Offset(0, nbCol - 1)).Value
End With
Randomize
h = UBound(u, 1)
ReDim v(1 To h)
For i = 1 To h: v(i) = i: Next i
For i = 2 To h: j = v(i): v(i) = v(i + Int((h - i + 1) * Rnd)): v(i + Int((h - i + 1) * Rnd(0))) = j: Next i
If 0 > k Then k = 0 Else If k > h - 1 Then k = h - 1
k = k + 1: ReDim w(1 To k, 1 To nbCol)
For i = 1 To k: For j = 1 To nbCol: w(i, j) = u(v(i), j): Next j, i
With Application: .ScreenUpdating = False: .EnableEvents = False: End With
With Destination: .Resize(h, nbCol).ClearContents: .Resize(k, nbCol).Value = w: End With
With Application: .EnableEvents = True: .ScreenUpdating = True: End With
End Sub