créer des groupes à partir d'une liste

[starz]

Bonjour à tous,
J'aurais besoin d'un coup de main pour créer 5 groupes de 4 personnes (feuille QUALIF) à partir d'une liste de 20 Pseudo (et nom prénom)

je voudrais créer des groupes aléatoirement mais 1 seul fois. Les pseudo doivent apparaîtrent sur la feuille QUALIF

Il y a aussi la possibilité d'avoir un groupe de 2 ou 3 si la liste de base ne contient pas les 20 pilotes.

je vous joins un fichier pour exemple

 

[vgendron]

Hello
un test avec ce code

Sub qualif()
Dim tablo() As Variant
Dim tablo2() As Variant

tablo = Sheets("PILOTES").Range("B3:B22").Value
ReDim tablo2(1 To UBound(tablo, 1), 2)
For i = LBound(tablo2, 1) To UBound(tablo2, 1)
    tablo2(i, 1) = ""
Next i
i = 1
While tablo2(UBound(tablo2, 1), 1) = ""
    DejaTiré = False
    tirage = WorksheetFunction.RandBetween(1, 20)
    For j = LBound(tablo2, 1) To UBound(tablo2, 1)
        If tablo2(j, 1) = tirage Then
            DejaTiré = True
            Exit For
        End If
    Next j
    If Not DejaTiré Then
        tablo2(i, 1) = tirage
        tablo2(i, 2) = tablo(tirage, 1)
       
        i = i + 1
        DejaTiré = False
    End If
Wend

 saut = 0
For i = LBound(tablo2, 1) To UBound(tablo2, 1)
   Sheets("Qualif").Range("D2").Offset(i + saut, 0) = tablo2(i, 2)
   If i Mod 4 = 0 Then saut = saut + 1
Next i

End Sub

 

[vgendron]

Avec une modif pour les cas ou il y a moins de 20 (ou plus) de personnes

Sub qualif()
Dim tablo() As Variant
Dim tablo2() As Variant
nb = Sheets("PILOTES").Range("B" & Rows.Count).End(xlUp).Row 'récupère la dernière ligne de la colonne B

tablo = Sheets("PILOTES").Range("B3:B" & nb).Value 'on met les valeurs dans un tablo
ReDim tablo2(1 To UBound(tablo, 1), 2) 'on définit le tablo2 sur deux colonnes
For i = LBound(tablo2, 1) To UBound(tablo2, 1) 'on remplit la première colonne de tablo2 avec du vide
    tablo2(i, 1) = ""
Next i
i = 1
While tablo2(UBound(tablo2, 1), 1) = "" 'tant qu'on a rien mis dans la dernière ligne du tablo2
    DejaTiré = False
    tirage = WorksheetFunction.RandBetween(1, nb - 2) 'on fait un tirage
    For j = LBound(tablo2, 1) To UBound(tablo2, 1) 'on cherche le tirage dans tablo2
        If tablo2(j, 1) = tirage Then
            DejaTiré = True
            Exit For
        End If
    Next j
    If Not DejaTiré Then 'si pas trouvé
        tablo2(i, 1) = tirage 'on met la valeur en colone 1
        tablo2(i, 2) = tablo(tirage, 1) 'on récupère le nom pour le mettre en colonne 2: ex si tirage = 5--> on met le 5eme nom
      
        i = i + 1
        DejaTiré = False
    End If
Wend
'ici on a rempli le tablo2 avec tous les noms présents dans le désordre
saut = 0
For i = LBound(tablo2, 1) To UBound(tablo2, 1) 'on replace tout le monde dans la feuille Qualif
   Sheets("Qualif").Range("D2").Offset(i + saut, 0) = tablo2(i, 2)
   If i Mod 4 = 0 Then saut = saut + 1
Next i
End Sub

 

[starz]

bonjour et merci.
comment et ou dois-je coller le code ?
je suis perdu

 

[vgendron]

ha pardon,
il s'agit d'une macro qu'il faut mettre dans un module standard VBA
1) ouvrir l'éditeur : Alt+F11
2) à gauche, insérer nouveau module stantard

3) à droite dans la fenetre de code: coller le code

voir PJ ; j'ai ajouté un bouton pour lancer le code

 

[starz]

Merci c'est parfait

 

[kingfadhel]

Bonsoir,
Une solution VBA.