Explication partie code vba

Bonsoir,

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é.
Code:

1 2 3 4 5 6 7 8 9 10 11 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.

1 pièce(s) jointe(s)

Bonjour à tout le forum,

Voici la macro complète, peut être que le bout de code que je vous avais transmis n'est pas suffisant, ainsi que le fichier.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
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

Bonjour,

De l'aide, Merci !!!