XL 2016 Tirage pour une tombola

Sub Bouton1_Cliquer()

    Dim LastLig As Integer, i As Integer, j As Integer
    Dim k As Integer, m As Integer, Lot As Integer
    Dim Deb As Integer, x As Long, LotNum As Integer, LotLig As Integer
    Dim incr As Integer, NbLot As Integer
    Dim CompareVal As Variant
    Dim Tb As Variant

    Application.ScreenUpdating = False

    With Sheets("ListTicket")    'à adapter

        LastLig = .Cells(Rows.Count, 1).End(xlUp).Row

        ' partie qui génère la liste de lots
        Dim InputNbLot As Variant
        InputNbLot = InputBox("Combien de lots cette année?", "Nombre Total de Lots")

        ' vérifier si l'entrée est un nombre valide
        If IsNumeric(InputNbLot) And InputNbLot <> "" Then  ' Si nombre de lot pas rempli ou non numérique alors message d'erreur
            Lot = CInt(InputNbLot)  ' Transforme le chiffre de la boîte de dialogue en valeur numérique

            ' Vérification que le nombre de lots n'excède pas le nombre de valeurs disponibles dans la colonne A
            If Lot > LastLig - 1 Then
                MsgBox "Le nombre de lots demandé dépasse le nombre de numéros disponibles."
                Application.ScreenUpdating = True
                Exit Sub
            End If

            LotLig = Lot + 2  ' On ajoute 2 car le remplissage de la colonne commence à 3 donc le dernier lot sera à x+2
            Deb = 3  ' On commence à la ligne 3
            LotNum = 1  ' le premier lot commence à 1
            incr = 1  ' on incrémente de 1 en 1

            ' Génération des lots
            For x = Deb To Lot + Deb - 1
                Sheets("ListTicket").Cells(x, 4).Value = LotNum
                LotNum = LotNum + incr
            Next x

            ' partie qui génère le tirage au sort
            i = 3: j = 5  ' coordonnées de la 1ère cellule où écrire les données
            Tb = .Range("A2:A" & LastLig).Value  ' Liste des valeurs dont on veut un tirage
            CompareVal = Range("E3:E" & LastLig)  ' Création de la sélection colonne E

            Do While Lot > 0
                Randomize
                m = Int((LastLig - 1) * Rnd() + 1)  ' sélection aléatoire de valeur
                .Cells(i, j).Value = Tb(m, 1)  ' mettre la valeur dans la cellule

                ' Déplacement des valeurs restantes pour éviter les doublons
                For k = m To UBound(Tb) - 1
                    Tb(k, 1) = Tb(k + 1, 1)
                Next k

                LastLig = LastLig - 1
                Lot = Lot - 1
                i = i + 1
            Loop
        Else
            MsgBox "Donner un nombre valide pour le nombre total de lots"
        End If
    End With

    Application.ScreenUpdating = True

End Sub

Sub Jeux()
Dim Nb As Integer, i As Integer, T As Integer, Tickets As New Collection
Nb = Application.InputBox("Veuillez entrer un nombre entier :", "Saisie d'un nombre entier", Type:=1)
If nb=0 then exit sub
With ThisWorkbook.Sheets("ListTicket")
    .Range(.Range("D3"), .Cells(.Rows.Count, "D").End(xlUp).Offset(3, 1)).Clear
' initialisation de la collection de tickets
    For i = 2 To .Range("A1").CurrentRegion.Rows.Count
        Tickets.Add CStr(.Cells(i, "A"))
    Next
      Randomize Timer
    For i = 1 To Nb
        .Range("D2").Offset(i) = i
         ' Tirage allétoire
        T = Int(Tickets.Count * Rnd() + 1)
        .Range("E2").Offset(i) = Tickets(T)
        Tickets.Remove (T) ' suppression du ticket.
    Next
End With
Set Tickets = Nothing
End Sub

Option Explicit
Sub Bouton1_Cliquer()
   Dim TTck(), LAt As New ListeAléat, LTir As Long, LTck As Long, TTir()
   TTck = Feuil1.[A2].Resize([A1000000].End(xlUp).Row - 1).Value
   Randomize
   LAt.Init UBound(TTck, 1)
   LTir = InputBox("Combien de lots cette année ?", "Nombre Total de Lots")
   If LTir > UBound(TTck, 1) Then LTir = UBound(TTck, 1)
   ReDim TTir(1 To LTir, 1 To 2)
   For LTir = 1 To UBound(TTir, 1)
        LTck = LAt.Aléat(LTir)
        TTir(LTir, 1) = LTir
        TTir(LTir, 2) = TTck(LTck, 1)
        Next LTir
   Feuil1.[D3:E5000].ClearContents
   Feuil1.[D3].Resize(UBound(TTir, 1), 2).Value = TTir
   End Sub

Sub tirageAlea()
Dim nbrLot&, derlig&, nbrTicket&, rep
   Application.ScreenUpdating = False                                ' pas d'actualisation de l'affichage (plus rapide)
   rep = Application.CountA(Range("d3:e3").Resize(Rows.Count - 2))   ' nombre de valeurs dans le tirage déjà affiché
   If rep > 0 Then   ' si un tirage semble exister
      rep = MsgBox("Il est possible qu'un tirage existe déjà." & vbLf & _
         "Voulez-vous le supprimer et procéder à un nouveau tirage ?", vbQuestion + vbYesNo + vbDefaultButton2)   ' on demande de confirmer le tirage
      If rep <> vbYes Then MsgBox "Abondon du tirage", vbInformation: Exit Sub      ' si refus d'un nouveau tirage, on arrête la macro
   End If
   Sheets("ListTicket").Select                  ' sélection de la feuille "ListTicket"
   Range("d3:e" & Rows.Count).ClearContents     ' effacement du précédent tirage
   nbrLot = CLng(Val(InputBox("Nombre de lot pour cette année ?" & vbLf & "( >0 ou sinon on quitte l'exécution) :")))   ' demande du nombre de lots
   If nbrLot <= 0 Then MsgBox "Aucun lot ! Arrêt de l'exécution.", vbCritical: Exit Sub   ' si le nombre de lot n'est pas supérieur à 0 alors on arrête la macro
   Range("a1").Resize(Rows.Count).RemoveDuplicates , Header:=xlYes   ' par précaution, on supprime les tickets en doublons
   nbrTicket = Cells(Rows.Count, "a").End(xlUp).Row - 1     ' le nombre de tickets
   If derlig = 1 Then MsgBox "Aucun ticket => on quitte l'exécution", vbCritical: Exit Sub   ' si aucun ticket alors on arrête la macro
   If nbrLot > nbrTicket Then nbrLot = nbrTicket      ' on ramène le nombre de lots au nombre de tickets (si plus de lots que de tickets)
   Range("a2").Resize(nbrTicket).Copy Range("e3")     ' on recopie la liste des tickets en colonne E
   Range("d3").Resize(nbrTicket).Formula = "=RAND()"  ' on met des nombres aléatoires dans la colonne D via une formule
   Range("d3:e3").Resize(nbrTicket).Sort key1:=Range("d3"), Header:=xlNo   ' on trie les colonnes D à E en fonction de la colonne E
   Range("d3").Resize(nbrLot).Formula = "=ROW()-2"                         ' dans la colonne D, on met une formule pour mettre les valeurs 1, 2, 3, ...
   Range("d3").Resize(nbrLot) = Range("d3").Resize(nbrLot).Value           ' on convertit les formules en leur valeur
   Range(Cells(nbrLot + 3, "d"), Cells(Rows.Count, "e")).ClearContents     ' on efface les lignes sous le dernier lot
End Sub

Sub Bouton1_Cliquer()
    Dim LTir As Long, i As Long
    Dim MyArray As BetterArray
    Set MyArray = New BetterArray
    Application.ScreenUpdating = False
    Feuil1.[D3:E5000].ClearContents
    MyArray.FromExcelRange Feuil1.[A2].Resize([A1000000].End(xlUp).row - 1)
    MyArray.Shuffle  ' mélange  des éléments du tableau
    LTir = InputBox("Combien de lots cette année ?", "Nombre Total de Lots")
    For i = 1 To LTir
       Feuil1.[D3].offset(i - 1, 0) = i
       Feuil1.[E3].offset(i - 1, 0) = MyArray.Items(i)
    Next i
    Application.ScreenUpdating = True
End Sub

Sub Bouton1_Cliquer()
    Dim LTir As Long, i As Long
    Dim MyArray As BetterArray
    Set MyArray = New BetterArray
    Feuil1.[D3:E5000].ClearContents
    MyArray.FromExcelRange Feuil1.[A2], True ' Last Row
    MyArray.Shuffle  ' mélange  des éléments du tableau
    LTir = InputBox("Combien de lots cette année ?", "Nombre Total de Lots")
    Feuil1.[D3] = 1: Feuil1.[D3].Select
    Selection.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1, Stop:=LTir
    MyArray.Capacity = LTir
    MyArray.ToExcelRange Feuil1.[E3]
End Sub