Makro Passwort sperren - Fehlersuche

Question

Hallo ihr Lieben,

ich habe ein Makro/Excel Problem - bzw. finde ich den Fehler nicht. Ich möchte dass das Makro erst ausgeführt wird nachdem man ein Passwort eingegeben hat.
Leider wird bei mir gar nicht erst nach einem Passwort gefragt, das Makro wird einfach ausgeführt.
Wo liegt der Fehler in meinem Code?

Sub Tabellenschutz()
If Application.InputBox("Bitte geben Sie ein Passwort ein!", "Passwortabfrage") = "test" Then
Sheets("Januar").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Februar").Select
Range("F9").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("März").Select
Range("A1:M36").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Range("G26").Select
Sheets("April").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Mai").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Juni").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Juli").Select
Range("A1").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("August").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("September").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Oktober").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("November").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Dezember").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Vorgabe").Select
Else
MsgBox "Sie haben nicht die Berechtigung, das Makro auszuführen", vbCritical, "Fehler"
End If
End Sub

Dankeschön!
Grüße
Nadine

Answer 1

Hallo Nadine,

bei mir läuft Dein Makro ohne Probleme.

Der Code gehört in ein allgemeines Modul.

Habe ihn mal etwas optimiert, so läuft er auch.

Option Explicit

Sub Tabellenschutz()
Dim intI As Integer
If Application.InputBox("Bitte geben Sie ein Passwort ein!",
"Passwortabfrage") = "test" Then
For intI = 1 To Worksheets.Count
Sheets(intI).Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
Next
Else
MsgBox "Sie haben nicht die Berechtigung, das Makro
auszuführen", vbCritical, "Fehler"
End If
End Sub

Gruß
Rainer