code hört nicht auf

Private Sub CommandButton1_Click()
Dim objSheet As Object
Dim blnFound As Boolean
TextBox1.Value = Trim$(TextBox1.Value)
If TextBox1.Value <> "" Then
For Each objSheet In ThisWorkbook.Sheets
If objSheet.Name = TextBox1.Value Then
blnFound = True
Exit For
End If
Next
If MsgBox("Soll die Disziplin ''" & TextBox1.Value & "'' erstellt werden?", vbYesNo + vbQuestion, "Disziplin erstellen") = vbNo Then
Unload Me
End If
If Not blnFound Then
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
Worksheets("Disziplin").Copy After:=Worksheets(3)
ActiveSheet.Name = TextBox1.Value
Worksheets("Menüe").Select
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
Unload Me
Else
MsgBox "Der Name ''" & TextBox1.Value & "'' ist schon vergeben." & vbLf & _
"Bitte geben Sie einen anderen Namen ein.", vbExclamation, "Hinweis"
With TextBox1
.SelStart = 0
.SelLength = .TextLength
.SetFocus
End With
End If
Else
MsgBox "Sie haben keinen Namen eingegeben.", vbExclamation, "Hinweis"
TextBox1.SetFocus
End If
End Sub