Probleme bei Passwortschutz von Tabellenblatt

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("K2:K" & Cells(Rows.Count, "K").End(xlUp).Row + 1)) Is Nothing _
And Target.Count = 1 Then _
AlterWert = Target.Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Tab2 As Range, rowOffset As Long, strAdress As String
Dim B As Long, A As Long, C As Long
Dim ws As Worksheet
Sheets("Gesamtdaten").Unprotect "gesamtdaten"
If Not Intersect(Target, Range("K2:K" & Cells(Rows.Count, "K").End(xlUp).Row + 1)) Is Nothing _
And _
Target.Count = 1 And Target.Address > "" Then
ActiveWorkbook.Unprotect "daten"
For Each ws In Worksheets
If ws.Name = AlterWert Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
Next
ActiveWorkbook.Protect "daten"
End If
If Not Intersect(Target, Range("B3")) Is Nothing Then
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
On Error GoTo Fehler1:
With Tabelle2
rowOffset = .Rows(2).Find(What:=Range("B3"), LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Column - 3
Range("B5:B" & Rows.Count).ClearContents
strAdress = .Range(.Cells(4, rowOffset), _
.Cells(56, rowOffset)).Address
.Range(strAdress).Copy Range("B5")
Range("E5:G" & Rows.Count).ClearContents
strAdress = .Range(.Cells(4, rowOffset + 1), _
.Cells(56, rowOffset + 5)).Address
.Range(strAdress).Copy Range("C5")
End With
ElseIf Not Intersect(Target, Columns(11)) Is Nothing Then
ArztAnlegen Intersect(Target, Columns(11))
Me.Activate
End If
Fehler1:
AnzeigeAn
If Err.Number  0 Then
MsgBox Err.Description, vbCritical, "Fehler beim Lesen!"
Sheets("Gesamtdaten").Protect "gesamtdaten"
Exit Sub
End If
On Error GoTo Fehler:
If Selection.Count > 1 Then
For C = 1 To Selection.Count
If Intersect(Selection(C), Range("E5:G56", "B5:B56")) Is Nothing Then _
Exit Sub
AnzeigeAn
B = Tabelle2.Rows(2).Find(What:=Range("B3"), LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Column - 2
For A = 0 To 5
If A  3 Then
If A = 5 Then
Tabelle2.Cells(Selection(C).Row - 1, B - 1) = _
Cells(Selection(C).Row, 2).Value
Else
Tabelle2.Cells(Selection(C).Row - 1, B + A).Value = _
Cells(Selection(C).Row, 3 + A).Value
End If
End If
Next A
Next C
Else
If Intersect(Target, Range("E5:G56", "B5:B56")) Is Nothing Then Exit Sub
AnzeigeAn
B = Tabelle2.Rows(2).Find(What:=Range("B3"), LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Column - 2
For A = 0 To 5
If A  3 Then
If A = 5 Then
Tabelle2.Cells(Target.Row - 1, B - 1) = Cells(Target.Row, 2).Value
Else
Debug.Print Cells(Target.Row, 3 + A)
Tabelle2.Cells(Target.Row - 1, B + A).Value = _
Cells(Target.Row, 3 + A).Value
End If
End If
Next A
End If
Fehler:
AnzeigeAn
If Err.Number  0 Then MsgBox Err.Description, vbCritical, _
"Fehler beim schreiben!"
Sheets("Gesamtdaten").Protect "gesamtdaten"
End Sub

Private Sub AnzeigeAn()
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

Sub Gesamt()
Application.EnableEvents = True
Sheets("Gesamtdaten").Protect "gesamtdaten"
End Sub

Private Sub ArztAnlegen(rngB As Range)
Dim rngK As Range, lngI As Long
ActiveWorkbook.Unprotect "daten"
For Each rngK In rngB
If rngK.Row > 1 Then
If Len(rngK)  "" Then
For lngI = 1 To Sheets.Count
If Sheets(lngI).Name = "" & rngK Then
MsgBox "Das Blatt " & rngK & " gibt es schon!"
Exit For
End If
Next lngI
If lngI > Sheets.Count Then
Sheets("Muster").Copy After:=Sheets(lngI - 1)
With ActiveSheet
.Name = rngK
.Cells(7, 4) = rngK
.Protect Password:=rngK
.Visible = True
End With
End If
End If
End If
Next rngK
ActiveWorkbook.Protect "daten"
End Sub

Es geht um den Passwortschutz von "Gesamtdaten". Ich habe es ja mit Unprotect und Protect schon reingeschrieben, aber es klappt noch nicht so wie ich will.
Ich habe dieses Tabellenblatt und noch ein anderes das "Gesamt" heißt. Auf diesem werden jeden Monat Werte eingetragen, die dann per VBA auf "Gesamtdaten" übertragen werden.
Nun wollte ich das Blatt "Gesamtdaten" per Passwort schützen und dies sollte automatisch in dem Makro funktionieren.
Das klappt auch teilweise. Wenn ich das Blatt "Gesamtdaten" über Extras - Schutz schütze und wechsle in das Blatt "Gesamt" und gebe was ein und wechsle dann wieder zu "Gesamtdaten" dann bleibt der Schutz aufrecht.
Wenn ich aber auf "Gesamt" den Monat wechsle (per Dropdown-Menü), dann ist der Schutz plötzlich bei "Gesamtdaten" weg.
Kann mir jemand sagen was ich an dem obigen Code ändern muss, damit dies klappt.
Danke schon mal für die Hilfe.
Viele Grüße Oblivion