Randomize List VBA

Question

Je suis assez nouveau à VBA. J'essaie de randomiser une liste avec VBA. La liste comporte deux en-têtes "Nom" et "Cadrans". Je veux essayer de randomiser la liste avec une macro puis l'appliquer avec un bouton. J'ai essayé d'utiliser le code ci-dessous mais il randomise les noms et les nombres mais ne les garde pas ensemble. Signification Si Mon nom est Jon et que j'ai eu 3 cadrans, cela déplace mes cadrans ailleurs. Toute aide serait appréciée.

Merci,

Sub Random() 
     Dim tempString As String 
     Dim tempInteger As Integer 
     Dim i As Integer 
     Dim j As Integer 

     For i = 1 To 5 
      Cells(i, 2).Value = WorksheetFunction.RandBetween(0, 1000) 
     Next i 

    For i = 1 To 5 
     For j = i + 1 To 5 

     If Cells(j, 2).Value < Cells(i, 2).Value Then 

     tempString = Cells(i, 2).Value 
     Cells(i, 2).Value = Cells(j, 2).Value 
     Cells(j, 2).Value = tempString 
     tempInteger = Cells(i, 2).Value 
     Cells(i, 2).Value = Cells(j, 2).Value 
     Cells(j, 2).Value = tempInteger 

     End If 

     Next j 
    Next i 
End Sub 

Answer 1

Comme @jsotola dit, le tri semble la meilleure façon de le faire:

Sub Randomer() 
Dim i As Long, startRow As Long, endRow As Long 
Dim ws As Worksheet 

Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 

Set ws = ActiveSheet 

startRow = 2 
endRow = WorksheetFunction.Max(_ 
    ws.Cells(ws.Rows.Count, 1).End(xlUp).Row, _ 
    ws.Cells(ws.Rows.Count, 2).End(xlUp).Row) 

For i = startRow To endRow 
    Randomize 
    ws.Cells(i, 3).Value = WorksheetFunction.RandBetween(1, 1000) 
Next i 

ws.Sort.SortFields.Clear 
ws.Sort.SortFields.Add Key:=Range("C" & startRow & ":C" & endRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 

With ws.Sort 
    .SetRange Range("A" & startRow & ":C" & endRow) 
    .Header = xlNo 
    .MatchCase = False 
    .Orientation = xlTopToBottom 
    .SortMethod = xlPinYin 
    .Apply 
End With 

ws.Range(ws.Cells(startRow, 3), ws.Cells(endRow, 3)).ClearContents 

Application.Calculation = xlCalculationAutomatic 
Application.ScreenUpdating = True 

End Sub