Abgleich Sheet vorhanden in For Each

Private Sub CommandButton1_Click()
n = 3
For Each NeueTabelle In Worksheets("Aufträge").Range("B3:B100").Value
If Not IsEmpty(NeueTabelle) Then
Sheets("Maske").Copy After:=Sheets(Sheets.Count) 'Vorlagetabelle als letztes Blatt in die  _
Arbeitsmappe kopieren
Application.DisplayAlerts = False 'Rückfrage (nach dem Löschen einer bestehenden Tabelle)   _
unterdrücken
'Versuch, eine gleichnamige Tabelle zu löschen; bei Fehler (= Tabelle ohnehin nicht  _
vorhanden) einfach weitermache
On Error Resume Next: Sheets(NeueTabelle).Delete: On Error GoTo 0
Application.DisplayAlerts = True 'Systemeldungen wieder einschalten
Do While Cells(n, 3) = ""
n = n + 1
Loop
Application.CutCopyMode = False
Sheets("Aufträge").Cells(n, 3).Copy
Sheets(Sheets.Count).Select
Sheets(Sheets.Count).Cells(2, 1).Select
Sheets(Sheets.Count).Paste
n = n + 1
Do While Cells(n, 3) = ""
n = n + 1
Loop
Sheets(Sheets.Count).Name = NeueTabelle 'neue Tabelle (= letztes Blatt der Mappe)  _
umbenennen
End If
Next
Dim Zelle As Range
Dim rngSpalte As Range
Set rngSpalte = Range("B3:B73")
For Each Zelle In rngSpalte
If Zelle.Value  "" Then
Zelle.Hyperlinks.Add Zelle, "", "'" & Zelle.Value & "'!" & "A1"
End If
Next Zelle
End Sub