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