Svp j'ai besoin de l'aide pour arréter ma boucle infinie

Bonjour, voila le code j'ai modifié ce que vous m'avez dit mais le programme ne s'arréte pas

Dim Arret As Boolean
Private Sub Stop_Click()
Arret = True
End Sub

Private Sub Renitialiser_Click()
[B7:T7].ClearContents
[B3].ClearContents
[X3].ClearContents
[X5].ClearContents
[X7].ClearContents
[X9].ClearContents
[X11].ClearContents

End Sub

Private Sub Simulation_Click()
Dim j As Integer
Dim i As Integer
Arret = False
Do While Arret = False
DoEvents
Recommencer:
'code pour le lancement des passe dans le tunel
If Range("B1").Value <> "" Then 'vérifie que B1 n'est pas vide
Range("B7:T7").Value = "" 'réinitialise ton "tableau"
i = 2 'valEUr de Ma première colonne du tableau
Application.Wait Time + TimeSerial(0, 0, 1) 'attends 10 sec
Do Until Range("T7") <> "" 'conditionne la boucle jusqu'à la dernière colonne de ton tableau
If i > 2 Then Cells(7, i - 1).Value = Range("B1") 'mettre la valeur de B1 dans les cellule precedente
Cells(7, i).Value = Range("B1").Value 'mets ta valeurs dans la cellule de ton tableau
i = i + 1 'prochaine colonne

Application.Wait Time + TimeSerial(0, 0, 1) 'attends 10 sec
DoEvents
Loop
Range("B3") = Range("B3") + Range("T7")
GoTo Recommencer
'For i = 1 To Cells(j, 3) = ""
'For j = 13 To 42
'If Sheets(2).Cells(j, 2).Value = i Then
'C = Sheets(2).Cells(j, 3).Value
'Set r = Sheets(1).Range("X:X").Find(C)
'r = Sheets(2).Range("X5").Find(C)
'r = Sheets(2).Range("X7").Find(C)
'r = Sheets(2).Range("X9").Find(C)
'r = Sheets(2).Range("X10").Find(C)
'Sheets(2).Cells(r.Row + 1, r.Column).Value = Sheets(2).Range("T7").Value
'End If: Next j: Next i
'i = 1

End If
Loop
End Sub