Hi SJ,

danke schonmal für dein Beispielprogramm. Kann mich aber VBA die nächsten Tage wieder nicht mehr zuwenden.

Kannst du mir nur noch sagen, wie ich automatisch den Blattschutz aktivieren kann nach dem Schließen der Excel.

Hatte folgendes probiert aber hilft mir nicht:

'''''''Private Sub Workbook_BeforeClose(Cancel As Boolean)
''''''''Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Option Explicit
Public sPwd As String

Sub unprotec_sheet()
    On Error GoTo Nicht_frei
    sPwd = InputBox("Passwort eingeben:", "Blatt entsperren")
    If sPwd <> "" Then

        'ActiveSheet.Unprotect Password:=sPwd
         ActiveWorkbook.Sheets("Eingabemaske").Unprotect Password:=sPwd
         ActiveWorkbook.Sheets("Bel. Plan").Unprotect Password:=sPwd
         ActiveWorkbook.Sheets("Düsenprotokoll_01").Unprotect Password:=sPwd
         ActiveWorkbook.Sheets("Düsenprotokoll_02").Unprotect Password:=sPwd
        MsgBox "Blattschutz FREIGEGEBEN!"
        Sheets("Eingabemaske").Select
        Exit Sub
    End If
Nicht_frei:
    MsgBox "Blattschutz NICHT freigegeben!"
End Sub

Sub protect_sheet()
'''''''Private Sub Workbook_BeforeClose(Cancel As Boolean)
''''''''Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
       ActiveWorkbook.Sheets("Eingabemaske").Protect Password:=sPwd, DrawingObjects:=True, Contents:=True, Scenarios:=True
       ActiveWorkbook.Sheets("Bel. Plan").Protect Password:=sPwd, DrawingObjects:=True, Contents:=True, Scenarios:=True
       ActiveWorkbook.Sheets("Düsenprotokoll_01").Protect Password:=sPwd, DrawingObjects:=True, Contents:=True, Scenarios:=True
       ActiveWorkbook.Sheets("Düsenprotokoll_02").Protect Password:=sPwd, DrawingObjects:=True, Contents:=True, Scenarios:=True
       'ThisWorkbook.Save
End Sub