Copier cellules au hasard

Sub AleaCell()

Dim TabFin(), Tablo(1 To 2, 1 To 23)
Dim k As Byte, x As Integer, m As Byte, l As Byte, j As Byte, h As Byte
Dim temp1, temp2
Randomize

For k = 1 To 23
  Tablo(1, k) = Rnd
  Tablo(2, k) = k + 19
Next

For k = 1 To 23
  For x = 2 To 23
     If Tablo(1, k) > Tablo(1, x) Then
        temp1 = Tablo(1, x)
        temp2 = Tablo(2, x)
        Tablo(1, x) = Tablo(1, k)
        Tablo(2, x) = Tablo(2, k)
        Tablo(1, k) = temp1
        Tablo(2, k) = temp2
     End If
  Next
Next

m = 0
For l = LBound(Tablo, 2) To UBound(Tablo, 2)
   ReDim Preserve TabFin(m)
   TabFin(m) = Tablo(2, l)
   m = m + 1
 Next

h = 20
For j = LBound(TabFin) To UBound(TabFin)
 Cells(TabFin(j), 52).Copy Cells(h, 6)
 h = h + 1
Next
   
End Sub

Sub AleaCell()

Dim TabFin(), Tablo(1 To 2, 1 To 23), TabRecopi()
Dim k As Byte, x As Integer, m As Byte, l As Byte, j As Byte, h As Byte, s As Byte, d As Byte
Dim temp1, temp2
Randomize

For k = 1 To 23
  Tablo(1, k) = Rnd
  Tablo(2, k) = k + 19
Next

For k = 1 To 23
  For x = 2 To 23
     If Tablo(1, k) > Tablo(1, x) Then
        temp1 = Tablo(1, x)
        temp2 = Tablo(2, x)
        Tablo(1, x) = Tablo(1, k)
        Tablo(2, x) = Tablo(2, k)
        Tablo(1, k) = temp1
        Tablo(2, k) = temp2
     End If
  Next
Next

m = 0
For l = LBound(Tablo, 2) To UBound(Tablo, 2)
   ReDim Preserve TabFin(m)
   TabFin(m) = Tablo(2, l)
   m = m + 1
 Next

s = 0
For j = LBound(TabFin) To UBound(TabFin)
 If Cells(TabFin(j), 52) <> "" Then
   ReDim Preserve TabRecopi(s)
   TabRecopi(s) = TabFin(j)
   s = s + 1
 End If
Next

h = 20
For d = LBound(TabRecopi) To UBound(TabRecopi)
 Cells(TabRecopi(d), 52).Copy Cells(h, 6)
 h = h + 2
Next
   
End Sub