Explication partie code VBA

Bonjour,

J'ai récupéré sur le net un code vba pour un tirage au sort aléatoire pour une compétition sportive.

En fait une fois le tirage au sort réalisé, les n°s des équipes apparaissent sur la même feuille dans les colonnes suivantes (ex: colonne F ligne 4, la 1ère équipe du GR.A, ligne 5, la 2ème du GR.B ..... colonne H ligne 4 la 1ère équipe du GR.B ..... etc)

J'aimerais pouvoir afficher directement les équipes dans leur groupe sur une autre feuille (1 feuille pour le GR.A, 1 pour le GR.B....), c'est pour cela que je fais appelle à vous afin de m'expliquer le morceau de code qui suit afin que je puisse essayer de l'adapter à ma volonté.

k = 1
For Lig = 4 To NbEquipesGroupe + 3
    For Col = 6 To NbGroupes * 2 + 5 Step 2
    On Error Resume Next
    If Err.Number = 0 Then
    .Cells(Lig, Col) = TabPts(k, 1)
    k = k + 1
    End If
    On Error GoTo 0
    Next Col
Next Lig

Merci d'avance pour les personnes qui me consacreront du temps.

Bonjour Youlig le forum

cette partie de code ne concerne pas un tirage au sort aléatoire, il manque un bout ou alors tu n'as pas bien compris comment cela marche

Une certitude tu aurais joint un petit fichier exemple en expliquant le résultat recherché tu aurais eu ta réponse

a+

papou

Bonjour Paritec,

Effectivement, cette partie de code ne correspond qu'à la partie de je souhaiterais modifié.

Voici la macro complète :

Sub TiragePoules()
Dim Derlig As Integer, TabPts, NbEquipes As Integer, Col As Byte, Lig As Byte, N As Integer, I As Integer, J As Integer, k As Integer, Temp
Dim Tirage As Integer, Coll As Collection, NbGroupes, NbEquipesGroupe

' Désactivation de l'affichage
Application.ScreenUpdating = False
With Sheets("Tirage Groupes")
.EnableSelection = xlNoRestrictions
.Unprotect Password:="50points"
' Effacement du tirage précédent
.Range("F4:Z100").ClearContents
' Mise en tableau des équipes
Derlig = .Range("A65536").End(xlUp).Row
TabPts = .Range("A4:B" & Derlig)
NbGroupes = .Range("C2").Value
NbEquipesGroupe = .Range("D2").Value
NbEquipes = Derlig - 3
' Vérification d'un nombre d'équipes insuffisant
If NbEquipes < NbGroupes - 1 * NbEquipesGroupe Then
MsgBox "Le nombre d'équipes est insuffisant pour le nombre de groupes et d'équipes par groupe !"
' nombre d'équipes participantes supérieur au produit du nombre de groupes par celui du nombre d'équipes par groupe
ElseIf NbEquipes > NbGroupes * NbEquipesGroupe Then
MsgBox "Le nombre d'équipes est supérieur au produit du nombre de groupes par celui des équipes par groupe !"
End If
' tirage des équipes
Set Coll = New Collection
N = 0
Do
Tirage = Int((Rnd * NbEquipes) + 1)
On Error Resume Next
Coll.Add Tirage, CStr(Tirage)
On Error GoTo 0
If Coll.Count > N Then
N = Coll.Count
TabPts(N, 2) = Coll(Coll.Count)
End If
Loop Until Coll.Count = NbEquipes
' Mise en ordre croissant du tirage
ReDim Temp(1 To 1, 1 To 2)
For I = 1 To UBound(TabPts, 1)
    For J = I + 1 To UBound(TabPts, 1)
    If TabPts(J, 2) < TabPts(I, 2) Then
    Temp(1, 1) = TabPts(I, 1): Temp(1, 2) = TabPts(I, 2)
    TabPts(I, 1) = TabPts(J, 1): TabPts(I, 2) = TabPts(J, 2)
    TabPts(J, 1) = Temp(1, 1): TabPts(J, 2) = Temp(1, 2)
    End If
    Next J
Next I
' Affichage des participants dans le tableau des Poules
k = 1
For Lig = 4 To NbEquipesGroupe + 3
    For Col = 6 To NbGroupes * 2 + 5 Step 2
    On Error Resume Next
    If Err.Number = 0 Then
    .Cells(Lig, Col) = TabPts(k, 1)
    k = k + 1
    End If
    On Error GoTo 0
    Next Col
Next Lig
.EnableSelection = xlUnlockedCells
.Protect Password:="50points", Contents:=True, UserInterfaceOnly:=True, Scenarios:=True
End With
End Sub

Voici donc le fichier avec quelques explications.

Merci d'avance

Bonjour à Tous,

De l'aide, Merci !!!