Excel stürzt beim Beenden ab

Sub Workbook_Open()
Dim ws As Worksheet
Application.DisplayAlerts = True
For Each ws In Worksheets
ws.Unprotect Password:="xxx"
ws.EnableAutoFilter = True
ws.EnableOutlining = True 'ermöglicht Gruppierung/Gliederung
ws.Protect AllowFormattingColumns:=True 'ermöglicht Ausblenden/Einblenden von Spalten
ws.Protect AllowFormattingRows:=True 'ermöglicht Ausblenden/Einblenden von Zeilen
ws.Protect UserInterfaceOnly:=True, Password:="xxx"
Next ws
End Sub

Sub Workbook_BeforeClose(Cancel As Boolean)

Dim ws As Worksheet

Worksheets("a").Unprotect Password:="xxx"

If Worksheets("a").FilterMode Then Worksheets("a").ShowAllData

Worksheets("a").Protect Password:="xxx"

Worksheets("b").Unprotect Password:="xxx"

If Worksheets("b").FilterMode Then Worksheets("b").ShowAllData

Worksheets("b").Protect Password:="xxx"

If ActiveWorkbook.ReadOnly = True Then 

For Each ws In ActiveWorkbook.Worksheets

ws.Protect Password:=xxx

ActiveSheet.Protect

Next ws

ActiveWorkbook.Close savechanges:=False

Exit Sub

Else:

For Each ws In ActiveWorkbook.Worksheets

ws.Protect Password:=xxx

ActiveSheet.Protect

Next ws

ActiveWorkbook.Close savechanges:=True

End If

End Sub