XL 2019 Mélange aléatoire colonne A sur colonne G ne fonctionne pas

[arvin]

bonjour, j'avais cette macro bien pratique qui copiait les noms de la colonne A sur la colonne G
(et ça sur toutes les feuilles)
les noms de la colonne A étaient mélangées aléatoirement
je ne comprends plus pourquoi ça mouline....et donc cela ne marche plus....

Sub melange()
For Each Ws In ActiveWorkbook.Sheets
Ws.Activate

Dim liste As Collection
Set liste = New Collection
nb = Range("A2").End(xlDown).Row - 1
Range("H1") = nb
While liste.Count < nb
Randomize
x = Int((nb * Rnd) + 1)
On Error Resume Next
liste.Add x, CStr(x)
On Error GoTo 0
Wend
For n = 1 To liste.Count
Range("G" & (n + 1)) = Range("A" & (liste(n) + 1))
Next n

Next Ws


End Sub

 

[vgendron]

bonjour

sans voir ton fichier. aucune idée.
mais peut etre que sur une feuille
nb = Range("A2").End(xlDown).Row - 1 te donne un nombre énorme;.
donc. quand tu penses que ca ne marche pas.. c'est que c'est juste très long..

en général, pour avoir la dernière ligne non vide d'une colone, on part du bas
nb=range("A" &rows.count).end(xlup).row

 

[Dranreb]

Bonjour.
Essayez comme ça :

Sub Melange()
   Dim Wsh As Worksheet, TNoms(), TAl() As Long, TRésu(), P&, R&, L&
   Randomize
   For Each Wsh In ActiveWorkbook.Worksheets
      TNoms = Wsh.[A2].Resize(Wsh.Cells(2 ^ 20, "A").End(xlUp).Row - 1).Value
      ReDim TAl(1 To UBound(TNoms, 1)), TRésu(1 To UBound(TNoms, 1), 1 To 1)
      TAl(1) = 1
      For P = 2 To UBound(TAl): R = Int(Rnd * P) + 1: If R < P Then TAl(P) = TAl(R)
         TAl(R) = P: Next P
      For P = 1 To UBound(TRésu, 1)
         L = TAl(P): TRésu(L, 1) = TNoms(P, 1)
         Next P
      Wsh.[G2].Resize(2 ^ 20 - 1).ClearContents
      Wsh.[G2].Resize(UBound(TRésu, 1)).Value = TRésu
      Next Wsh
   End Sub

 

[arvin]

Sub Melange() Dim Wsh As Worksheet, TNoms(), TAl() As Long, TRésu(), P&, R&, L& Randomize For Each Wsh In ActiveWorkbook.Worksheets TNoms = Wsh.[A2].Resize(Wsh.Cells(2 ^ 20, "A").End(xlUp).Row - 1).Value ReDim TAl(1 To UBound(TNoms, 1)), TRésu(1 To UBound(TNoms, 1), 1 To 1) TAl(1) = 1 For P = 2 To UBound(TAl): R = Int(Rnd * P) + 1: If R < P Then TAl(P) = TAl(R) TAl(R) = P: Next P For P = 1 To UBound(TRésu, 1) L = TAl(P): TRésu(L, 1) = TNoms(P, 1) Next P Wsh.[G2].Resize(2 ^ 20 - 1).ClearContents Wsh.[G2].Resize(UBound(TRésu, 1)).Value = TRésu Next Wsh End Sub

merci beaucoup , je regarde tout de suite