VBA : nommées des feuilles de calcul et mettre un Invite

Bonjour,

J'ai une feuille "poule" qui contient des joueurs à ventiler dans des tableaux à l'aide d'une feuille de correspondance via un bouton "Ventilation" qui fonctionne très bien, mais qui mérite quelques petits aménagements pour la suite de mon projet.

Actuellement, les feuilles dupliquées sont nommées comme suit par exemple « T4 Série C06 » qui correspond au tableau utilisé + le numéro de série . 18 feuilles sont créés correspondant chacune à une série.

Ainsi, je souhaiterai à ce que les feuilles dupliquées soient nommées par le numéro de série uniquement. Exemple : C00,C01,C02 etc….

En outre, avoir la possibilité de dupliquer une série particulière à la place de tout avoir en bloc comme actuellement

Enfin, il peut y avoir un bugg dans le cas où, le nombre de joueurs par série est inférieur à 4, comment je peux contourner le PB

Merci d’avance. Ce n'est pas parfait comme code, mais il fonctionne

Je peux vous joindre un fichier si vous voulez. Mais je ne me souviens plus comment faire

Sub Ventilation()

'*********Déclarations**********'
Dim TAB_C0(), TAB_C1(), TAB_C2(), TAB_C3(), TAB_C4(), TAB_C5C(), TAB_C5A(), TAB_C6(), TAB_C7(), TAB_C8(), TAB_C9(), TAB_C10(), TAB_C11(), TAB_C12(), TAB_C13(), TAB_C14(), TAB_C15(), TAB_C16()


'*********Capture des Tableaux de POULES**********'
TAB_C0 = Range("serie_C00").Value
TAB_C1 = Range("serie_C01").Value
TAB_C2 = Range("serie_C02").Value
TAB_C3 = Range("serie_C03").Value
TAB_C4 = Range("serie_C04").Value
TAB_C5A = Range("serie_C5A").Value
TAB_C5C = Range("serie_C5C").Value
TAB_C6 = Range("serie_C06").Value
TAB_C7 = Range("serie_C07").Value
TAB_C8 = Range("serie_C08").Value
TAB_C9 = Range("serie_C09").Value
TAB_C10 = Range("serie_C10").Value
TAB_C11 = Range("serie_C11").Value
TAB_C12 = Range("serie_C12").Value
TAB_C13 = Range("serie_C13").Value
TAB_C14 = Range("serie_C14").Value
TAB_C15 = Range("serie_C15").Value
TAB_C16 = Range("serie_C16").Value



'**************Création du Tableau C0*************'
Call Creation_Tableau(TAB_C0)
'**************Création du Tableau C1*************'
Call Creation_Tableau(TAB_C1)
'**************Création du Tableau C2*************'
Call Creation_Tableau(TAB_C2)
'**************Création du Tableau C3*************'
Call Creation_Tableau(TAB_C3)
'**************Création du Tableau C4*************'
Call Creation_Tableau(TAB_C4)
'**************Création du Tableau C5A*************'
Call Creation_Tableau(TAB_C5A)
'**************Création du Tableau C5C*************'
Call Creation_Tableau(TAB_C5C)
'**************Création du Tableau C6*************'
Call Creation_Tableau(TAB_C6)
'**************Création du Tableau C7*************'
Call Creation_Tableau(TAB_C7)
'**************Création du Tableau C8*************'
Call Creation_Tableau(TAB_C8)
'**************Création du Tableau C9*************'
Call Creation_Tableau(TAB_C9)
'**************Création du Tableau C10*************'
Call Creation_Tableau(TAB_C10)
'**************Création du Tableau C11*************'
Call Creation_Tableau(TAB_C11)
'**************Création du Tableau C12*************'
Call Creation_Tableau(TAB_C12)
'**************Création du Tableau C13*************'
Call Creation_Tableau(TAB_C13)
'**************Création du Tableau C14*************'
Call Creation_Tableau(TAB_C14)
'**************Création du Tableau C15*************'
Call Creation_Tableau(TAB_C15)
'**************Création du Tableau C16*************'
Call Creation_Tableau(TAB_C16)


End Sub

Function Creation_Tableau(TAB_TEMP)

Dim TAB_Final()

TAB_Final = Traitement(TAB_TEMP)
T_Temp = Select_TXX(TAB_Final(1, 1))

Nom_Feuille = T_Temp & " " & TAB_TEMP(1, 1)

Application.DisplayAlerts = False
If Sht(Nom_Feuille) = True Then Sheets(Nom_Feuille).Delete
Application.DisplayAlerts = True

Sheets(T_Temp).Copy After:=Sheets(T_Temp)
ActiveSheet.Name = Nom_Feuille

Call Create_Final(T_Temp, TAB_Final)

End Function



Function Create_Final(T_Temp, TAB_Final)

Indice = 2

Select Case T_Temp

    Case Is = "T64"
        For i = 2 To 130
            Range("B" & i) = TAB_Final(Indice, 1)
            Range("C" & i) = TAB_Final(Indice, 2)
            i = i + 1
            Indice = Indice + 1
        Next i

    Case Is = "T32"
        For i = 2 To 66
            Range("B" & i) = TAB_Final(Indice, 1)
            Range("C" & i) = TAB_Final(Indice, 2)
            i = i + 1
            Indice = Indice + 1
        Next i

    Case Is = "T16"
        
        For i = 2 To 34
            Range("B" & i) = TAB_Final(Indice, 1)
            Range("C" & i) = TAB_Final(Indice, 2)
            i = i + 1
            Indice = Indice + 1
        Next i

    Case Is = "T8"
    
        For i = 2 To 18
            Range("B" & i) = TAB_Final(Indice, 1)
            Range("C" & i) = TAB_Final(Indice, 2)
            i = i + 1
            Indice = Indice + 1
        Next i

    Case Is = "T4"
    
        For i = 2 To 10
            'If i = 6 Then i = 8
            Range("B" & i) = TAB_Final(Indice, 1)
            Range("C" & i) = TAB_Final(Indice, 2)
            i = i + 1
            Indice = Indice + 1
        Next i
End Select


End Function

Function Traitement(TAB_TEMP)
    Dim DIC_C0
    Dim TAB_Sortie()
    
    Set DIC_C0 = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(TAB_TEMP, 1)
        If TAB_TEMP(i, 2) = 1 Or TAB_TEMP(i, 2) = 2 Then DIC_C0.Add TAB_TEMP(i, 3), TAB_TEMP(i, 1)
    Next i
    
    TAB_Sortie = Range("Sortie_" & DIC_C0.Count).Value
    
    ReDim Preserve TAB_Sortie(1 To UBound(TAB_Sortie, 1), 1 To 2)
    
    For i = 2 To UBound(TAB_Sortie, 1)
        If DIC_C0.exists(TAB_Sortie(i, 1)) Then TAB_Sortie(i, 2) = DIC_C0(TAB_Sortie(i, 1))
    Next i
    Traitement = TAB_Sortie
End Function


Function Select_TXX(TEMP)

Dim T_Temp As String

Select Case TEMP

    Case Is > 32
            T_Temp = "T64"
    Case Is > 16
            T_Temp = "T32"
    Case Is > 8
            T_Temp = "T16"
    Case Is > 4
            T_Temp = "T8"
    Case Else
            T_Temp = "T4"
End Select
Select_TXX = T_Temp

End Function

Function Sht(Name) As Boolean
    Dim s As Object
    On Error Resume Next
    Set s = Sheets(Name)
    If Err = 0 Then Sht = True
    Set s = Nothing
End Function