Dim ws As Worksheet
    Dim password As String
    Dim protectedSheets As Collection
    Dim protectedWithPasswordSheets As Collection
    Dim newWorkbook As Workbook
    Dim newSheet As Worksheet
    Dim i As Integer

    ' Initialisiere die Collections
    Set protectedSheets = New Collection
    Set protectedWithPasswordSheets = New Collection

    ' Falls die Blätter passwortgeschützt sind, hier das Passwort eingeben
    password = "1"

    ' Schleife durch alle Arbeitsblätter im aktiven Arbeitsbuch
    For Each ws In ThisWorkbook.Worksheets
        ' Versuche, den Blattschutz aufzuheben
        On Error Resume Next ' Fehlerbehandlung deaktivieren
        ws.Unprotect password:=password
        If Err.Number <> 0 Then
            ' Wenn ein Fehler auftritt (d.h. das Blatt ist passwortgeschützt), erneut ohne Passwort versuchen
'            ws.Unprotect password:=password
            If Err.Number <> 0 Then
                ' Wenn ein Fehler auftritt (d.h. das Blatt ist passwortgeschützt mit Passwort), Blattname zur Collection hinzufügen
                protectedSheets.Add ws.Name
                protectedWithPasswordSheets.Add ws.Name
                ' Fehler zurücksetzen
                Err.Clear
            Else
                ' Blatt ist geschützt ohne Passwort
                protectedSheets.Add ws.Name
            End If
        Else
            ' Blatt war geschützt, aber ohne Passwort
            protectedSheets.Add ws.Name
        End If
        On Error GoTo 0 ' Fehlerbehandlung wieder aktivieren
    Next ws

    ' Neue Arbeitsmappe erstellen
    Set newWorkbook = Workbooks.Add
    Set newSheet = newWorkbook.Sheets(1)
    newSheet.Name = "Geschützte Blätter"
    
    ' Überschriften in die erste Zeile schreiben
    newSheet.Cells(1, 1).Value = "Geschützte Blätter"
    newSheet.Cells(1, 2).Value = "Mit Passwort"

    ' Die Namen der geschützten Blätter in die neue Tabelle einfügen
    For i = 1 To protectedSheets.Count
        newSheet.Cells(i + 1, 1).Value = protectedSheets(i)
        If Contains(protectedWithPasswordSheets, protectedSheets(i)) Then
            newSheet.Cells(i + 1, 2).Value = "Ja"
        Else
            newSheet.Cells(i + 1, 2).Value = "Nein"
        End If
    Next i
    
    MsgBox "Blattschutz für alle Blätter aufgehoben. Geschützte Blätter wurden aufgelistet."
End Sub

Function Contains(col As Collection, item As Variant) As Boolean
    Dim i As Variant
    For Each i In col
        If i = item Then
            Contains = True
            Exit Function
        End If
    Next i
    Contains = False
End Function


Hier noch verbessert. Es hebt bei allen Blättern den Blattschutz auf und listet, wenn es ein Blatt ist ohne bekanntes Passwort in einer neuen Tabelle auf.