Sheets anhand Zellenliste erstellen

Option Explicit
Option Compare Text
' Original-Quelltext unter: https://www.online-vba.de/sheets-anhand-zellenliste-erstellen
' Express-Hilfe für VBA unter https://www.online-vba.de/vba-expresshilfe
' Es gelten die Nutzungsbedingungen von Online-VBA.de

' Verwendung: Markieren Sie einen Zellenbereich und starten Sie dieses Makro

Public Sub OVBAde_ArbeitsblaetterVonListeErstellen()
  Dim oZelle As Object
  Dim oNewSheet As Object
  Dim lSuccessCounter As Long
  Dim lErrCounter As Long
    
    If Workbooks.Count < 1 Then Exit Sub
    lErrCounter = 0
    lSuccessCounter = 0
    
    'Sicherheitsabfrage
    If MsgBox("Sind Sie sicher, dass Sie " & Selection.Cells.Count & _
               " neue und leere Arbeitsblätter erstellen wollen?", _
               vbExclamation + vbYesNo, "HINWEIS!") = vbYes Then
        
        On Error Resume Next
        For Each oZelle In Selection.Cells
            If Trim(CStr(oZelle.Value)) <> "" Then
                Set oNewSheet = ActiveWorkbook.Sheets.Add(after:=Sheets(Sheets.Count))
                oNewSheet.Name = Trim(CStr(oZelle.Value))
                If Err.Number <> 0 Then
                    Err.Number = 0
                    Err.Clear
                    Application.DisplayAlerts = False
                    oNewSheet.Delete
                    Application.DisplayAlerts = True
                    lErrCounter = lErrCounter + 1
                Else
                    lSuccessCounter = lSuccessCounter + 1
                End If
            End If
        Next oZelle
        On Error GoTo 0
        
        If lErrCounter <> 0 Then
            MsgBox lErrCounter & " Arbeitsblätter konnten nicht erstellt werden, " & _
            "da ihr Name entweder bereits vorhanden ist oder ungültige Zeichen enthält!" & _
            vbCrLf & "Es wurden " & lSuccessCounter & " Arbeitsblätter erstellt.", _
            vbInFormation + vbOKOnly, "WARNUNG!"
        Else
            MsgBox "Es wurden " & lSuccessCounter & " Arbeitsblätter erstellt.", _
            vbInFormation + vbOKOnly, "HINWEIS!"
        End If
    
    End If
End Sub