Sub GagnantsConcoursTaT_2eP() ' Tirage 1ere partie concours

Dim Cl As Range
Dim Xa As Integer, Xc As Integer
'Dim Dl2 As Integer --> Dan : Remplacé par nb_lignes dans le code
Dim Nb_Lignes As Integer
Dim i As Long, Y As Long
Dim X As Integer
Dim Z As Integer

Application.ScreenUpdating = False

With Worksheets("Concours")
        
    Dl = .Cells(Rows.Count, "A").End(xlUp).Row
    Xa = Application.WorksheetFunction.CountA(.Range("A4:A" & Dl))
    Xc = Application.WorksheetFunction.CountA(.Range("C4:C" & Dl))
                
    If Xa <> Xc Then
    
        MsgBox "Il semble que tous les résultats ne soient pas saisis !", vbExclamation, "Il manque les résultats de " & Xa - Xc & " équipes /" & Xa & " !"
        Exit Sub
        
    End If
                
    .Unprotect  'déprotege le feuille
    
    .Range("A4:G" & .Range("Dl_" & Partie - 1)).Locked = True
                
    X = Application.WorksheetFunction.CountA(.Range("C" & .Range("Dl_" & Partie - 1).Value + 8 & ":C" & Dl + 1))
                
    If X > 0 Then
    
        MsgBox "Il y a déja des gagnants inscrit en 2e Partie. Impossible de continuer."
        End
        
    End If
                
    ' efface la plage "AF1:AFx" et "AH1:AHx" ou sont tirés au sort les équipes pour la 1 ere partie
    Nb_Lignes = .Cells(Rows.Count, "AF").End(xlUp).Row + 2 'Dan : remplacé D12 par Nb_lignes
    .Range("AF1:AF" & Nb_Lignes).ClearContents 'Dan : remplacé D12 par Nb_lignes
    .Range("AH1:AH" & Nb_Lignes).ClearContents 'Dan : remplacé D12 par Nb_lignes
                
    '' efface les cellules des colonnes K, L, O, P, du bloc des gagnants et S, T, W, Y du bloc des perdants (feuille "Consolante
    ' Derniere ligne de la colonne A une 2e fois car le champ 2e Partie a été effacé
    
    X = 1
    AleTri = 32  ' numéro de la colonne Gagnants
    
    For Each Cl In .Range("A4:A" & Dl)
        ' Recherche la lettre "G" dans les colonnes C et G et transfére le N° d'équipe colonnes "A" et "E" en colonne des gagnants "AG"
        If Cl > 0 Then
            If .Cells(Cl.Row, "C") = "G" Then .Cells(X, AleTri) = .Cells(Cl.Row, "A").Value
            If .Cells(Cl.Row, "G") = "G" Then .Cells(X, AleTri) = .Cells(Cl.Row, "E").Value
            X = X + 1
        End If
    Next Cl
   
    Call AleatoireTaT
    Call LeTriTat
                
    X = 1
    AleTri = 34  ' numéro de la colonne Perdants
    
    For Each Cl In .Range("E4:E" & Dl)
    
        ' Recherche la lettre "P" dans les colonnes C et G et transfére le N° d'équipe colonnes "A" et "E" en colonne des perdants "AF"
        If Cl > 0 Then
            If .Cells(Cl.Row, "C") = "P" Then .Cells(X, AleTri) = .Cells(Cl.Row, "A").Value
            If .Cells(Cl.Row, "G") = "P" Then .Cells(X, AleTri) = .Cells(Cl.Row, "E").Value
            X = X + 1
        End If
    Next

    Call AleatoireTaT
    Call LeTriTat
                
    Nb_Lignes = .Cells(Rows.Count, "AF").End(xlUp).Row
    Pl = .Range("Dl_" & Partie - 1).Value + 8
                
    ''''' Les gagnants ********************
    Y = .Range("Dl_" & Partie - 1).Value + 8
                
    For Z = 1 To Nb_Lignes Step 2
                
        For Each Cl In .Range("A4:A" & Dl, "E4:E" & Dl)
                        
            If Cl.Value = .Cells(Z, "AF").Value Then
                .Range("A" & Y) = .Cells(Cl.Row, Cl.Column)
                .Range("B" & Y) = .Cells(Cl.Row, Cl.Column + 1)
                Y = Y + 2
            End If
                        
        Next Cl
                        
    Next Z
    
    ''''''''''''' les adversaires
    Y = .Range("Dl_" & Partie - 1).Value + 8

    For Z = 2 To Nb_Lignes Step 2
    
        For Each Cl In .Range("A4:A" & Dl, "E4:E" & Dl)
                        
            If Cl.Value = .Cells(Z, "AF").Value Then
                .Range("E" & Y) = .Cells(Cl.Row, Cl.Column)
                .Range("F" & Y) = .Cells(Cl.Row, Cl.Column + 1)
                Y = Y + 2
            End If
                        
        Next Cl
    Next Z
            
    ''''' Les perdants *****************
    Y = .Range("Dl_" & Partie - 1).Value + 8
                
    For Z = 1 To Nb_Lignes Step 2
    
        For Each Cl In .Range("A4:A" & Dl, "E4:E" & Dl)
                        
            If Cl.Value = .Cells(Z, "AH").Value Then
                .Range("i" & Y) = .Cells(Cl.Row, Cl.Column)
                .Range("J" & Y) = .Cells(Cl.Row, Cl.Column + 1)
                Y = Y + 2
            End If
                        
        Next Cl
    Next Z
                
    ''''''''''''' les adversaires
    Y = .Range("Dl_" & Partie - 1).Value + 8
                
    For Z = 2 To Nb_Lignes Step 2
                
        For Each Cl In .Range("A4:A" & Dl, "E4:E" & Dl)
                        
            If Cl.Value = .Cells(Z, "AH").Value Then
                .Range("M" & Y) = .Cells(Cl.Row, Cl.Column)
                .Range("N" & Y) = .Cells(Cl.Row, Cl.Column + 1)
                Y = Y + 2
            End If
                        
        Next Cl
                        
    Next Z
                
    Call Me.EnteteLesP
    Call Me.GrilleLesP
                
    Dl = Cells(Rows.Count, "A").End(xlUp).Row
    'Y = .Cells(Dl - 2, "Q").Left
    'Z = .Cells(Dl - 2, "Q").Top
                
    With .Shapes.Range("Button 1") ' postionne le bouton "Tirage des partie" selon la derniere ligne de la Partie
        .Left = Cells(Dl - 2, "Q").Left 'Y
        .Top = Cells(Dl - 2, "Q").Top 'Z
        .Select
        Selection.Characters.Text = "Tirage " & Chr(10) & Partie + 1 & "e partie" & Chr(10) & "Tete a tete"
    End With
    
    .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With

Application.ScreenUpdating = True
End Sub

Sub GagnantsConcoursTaT_3eP() ' Tirage 1ere partie concours
Dim Cl As Range
Dim Xa As Integer, Xc As Integer
Dim Ya As Integer, Yc As Integer
Dim X As Integer, Y As Integer, Z As Integer
Dim Nb_Lignes As Integer '  derniere ligne tirage aélatoire (colonne AF et AH)

Application.ScreenUpdating = False

With Worksheets("Concours")

    Dl = .Cells(Rows.Count, "A").End(xlUp).Row
    Pl = .Range("Pl_" & (Partie - 1))
        
    Xa = Application.WorksheetFunction.CountA(.Range("A" & Pl & ":A" & Dl))
    Xc = Application.WorksheetFunction.CountA(.Range("C" & Pl & ":C" & Dl))
    Ya = Application.WorksheetFunction.CountA(.Range("i" & Pl & ":i" & Dl))
    Yc = Application.WorksheetFunction.CountA(.Range("K" & Pl & ":K" & Dl))
        
    If Xa <> Xc Then
        MsgBox "Il semble que tous les résultats ne soient pas saisis !", vbExclamation, "Il manque les résultats de " & Xa - Xc & " équipes /" & Xa & " !"
        Exit Sub
    End If
        
    If Ya <> Yc Then
        MsgBox "Il semble que tous les résultats ne soient pas saisis !", vbExclamation, "Il manque les résultats de " & Ya - Yc & " équipes /" & Ya & " !"
        Exit Sub
    End If
        
    .Unprotect  'déprotege le feuille
    .Range("A4:O" & Dl).Locked = True

    X = Application.WorksheetFunction.CountA(.Range("C" & .Range("Pl_" & Partie).Value & ":C" & Dl + 1))
    
    If X > 0 Then
        MsgBox "Il y a déja des gagnants inscrit en 3e Partie. Impossible de continuer."
        End
    End If
    
    ' efface la plage "AF1:AFx" et "AH1:AHx" ou sont tirés au sort les équipes pour la 1 ere partie
    Nb_Lignes = .Cells(Rows.Count, "AF").End(xlUp).Row
    .Range("AF1:AF" & Nb_Lignes).ClearContents
    .Range("AH1:AH" & Nb_Lignes).ClearContents
                
    '' efface les cellules des colonnes K, L, O, P, du bloc des gagnants et S, T, W, Y du bloc des perdants (feuille "Consolante
    ' Derniere ligne de la colonne A une 2e fois car le champ 2e Partie a été effacé
                
    X = 1
    AleTri = 32  ' numéro de la colonne Gagnants
    
    For Each Cl In .Range("A" & Pl & ":A" & Dl)
    
    ' Recherche la lettre "G" dans les colonnes C et G et transfére le N° d'équipe colonnes "A" et "E" en colonne des gagnants "AG"
        If Cl > 0 Then
            If .Cells(Cl.Row, "C") = "G" Then .Cells(X, 32) = .Cells(Cl.Row, "A").Value
            If .Cells(Cl.Row, "G") = "G" Then .Cells(X, 32) = .Cells(Cl.Row, "E").Value
            X = X + 1
        End If
    
    Next Cl
    
    Call AleatoireTaT
    Call LeTriTat
                
    X = 1
    AleTri = 34  ' numéro de la colonne Perdants
                
    For Each Cl In .Range("i" & Pl & ":i" & Dl)
    ' Recherche la lettre "P" dans les colonnes C et G et transfére le N° d'équipe colonnes "A" et "E" en colonne des perdants "AF"
        If Cl > 0 Then
            If .Cells(Cl.Row, "K") = "G" Then .Cells(X, AleTri) = .Cells(Cl.Row, "i").Value
            If .Cells(Cl.Row, "O") = "G" Then .Cells(X, AleTri) = .Cells(Cl.Row, "M").Value
            X = X + 1
        End If
                
    Next Cl
                
    Call AleatoireTaT
    Call LeTriTat
                
    Nb_Lignes = .Cells(Rows.Count, "AF").End(xlUp).Row
                
    ''''' Les gagnants ********************
    Y = .Range("Pl_" & Partie)  '''''''''''' premier bloc
                
    For Z = 1 To Nb_Lignes Step 2
                
        For Each Cl In .Range("A" & .Range("Pl_" & Partie - 1) & ":A" & Dl, "E" & .Range("Pl_" & Partie - 1) & ":E" & Dl)
                        
            If Cl.Value = .Cells(Z, "AF").Value Then
                .Range("A" & Y) = .Cells(Cl.Row, Cl.Column)
                .Range("B" & Y) = .Cells(Cl.Row, Cl.Column + 1)
                Y = Y + 2
            End If
                        
        Next Cl
                        
    Next Z
                
    Y = .Range("Pl_" & Partie)   ''''''''''''' les adversaires
                
    For Z = 2 To Nb_Lignes Step 2
                
        For Each Cl In .Range("A" & .Range("Pl_" & Partie - 1) & ":A" & Dl, "E" & .Range("Pl_" & Partie - 1) & ":E" & Dl)
                        
            If Cl.Value = .Cells(Z, "AF").Value Then
                .Range("E" & Y) = .Cells(Cl.Row, Cl.Column)
                .Range("F" & Y) = .Cells(Cl.Row, Cl.Column + 1)
                Y = Y + 2
            End If
                        
        Next Cl
                        
    Next Z
                
    Nb_Lignes = .Cells(Rows.Count, "AF").End(xlUp).Row
                
    ''''' Les perdants *****************
    Y = .Range("Pl_" & Partie)   '''''''''''' premier bloc
                
    For Z = 1 To Nb_Lignes Step 2
    
        For Each Cl In .Range("i" & .Range("Pl_" & Partie - 1) & ":i" & Dl, "M" & .Range("Pl_" & Partie - 1) & ":M" & Dl)
            
            If Cl.Value = .Cells(Z, "AH").Value Then
                .Range("i" & Y) = .Cells(Cl.Row, Cl.Column)
                .Range("J" & Y) = .Cells(Cl.Row, Cl.Column + 1)
                Y = Y + 2
            End If
            
        Next Cl
            
    Next Z
                
    Y = .Range("Pl_" & Partie)   ''''''''''''' les adversaires
                
    For Z = 2 To Nb_Lignes Step 2
                
        For Each Cl In .Range("i" & .Range("Pl_" & Partie - 1) & ":i" & Dl, "M" & .Range("Pl_" & Partie - 1) & ":M" & Dl)
                        
            If Cl.Value = .Cells(Z, "AH").Value Then
                .Range("M" & Y) = .Cells(Cl.Row, Cl.Column)
                .Range("N" & Y) = .Cells(Cl.Row, Cl.Column + 1)
                Y = Y + 2
            End If
                        
        Next Cl
                        
    Next Z
                
    Call EnteteLesP
    Call GrilleLesP
                
    Dl = .Cells(Rows.Count, "A").End(xlUp).Row
    
    'Y = .Cells(Dl, "Q").Left
    'Z = .Cells(Dl, "Q").Top
    
    With .Shapes.Range("Button 1") ' postionne le bouton "Tirage 2e partie" selon la derniere ligne de la Partie1
            .Left = Cells(Dl, "Q").Left 'Y
            .Top = Cells(Dl, "Q").Top 'Z
            .Select
            Selection.Characters.Text = "Tirage " & Chr(10) & Partie + 1 & "e partie" & Chr(10) & "Tete a tete"
    End With
    '.Cells(Dl, "T").Select
    
    .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With

Application.ScreenUpdating = True
End Sub