Option Explicit
Sub BlaetterGenerieren()
Const csBereich = A12:A20->< < < < A N P A S S E N > > >
Dim ws As Worksheet, wsa As Worksheet, Zelle As Range
Dim iReturn As Integer
Set wsa = ActiveSheet
On Error Resume Next
For Each Zelle In wsa.Range(csBereich)
If Zelle.Value <> Then
Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
ws.Name = Zelle.Value
If Err.Number <> 0 Then
wsa.Activate
ActiveWindow.ScrollRow = Zelle.Row
iReturn = MsgBox( _
Blatt konnte nicht entsprechend Zelle & _
Zelle.Address(False, False) & benannt werden. & vbLf & vbLf & _
Grund: & Err.Description & vbLf & vbLf & _
Fortfahren ?, vbDefaultButton1 + vbYesNo + vbQuestion)
Err.Clear
If vbYes <> iReturn Then Exit For
End If
End If
Next
wsa.Activate
AUFRAEUMEN:
Set ws = Nothing: Set wsa = Nothing: Set Zelle = Nothing
End Sub
