Inhaltsverz.+Blattschutz A1 wieder gesperrt soll f

Sub TableOfContents()
Dim i As Integer
Dim ws As Worksheet
Dim intWS As Integer
Dim lngRow As Long
Dim intCol As Integer
' Bildschirmaktualisierung aufheben
Application.ScreenUpdating = False
' Fensterfixierung aufheben
Call DeleteFreezePanes
' Falls bereits ein Tabellenblatt mit dem Namen
' "Inhaltsverzeichnis" vorhanden ist, dieses löschen
For Each ws In Worksheets
If ws.Name = "Inhaltsverzeichnis" Then
ws.Delete
End If
Next ws
' Variablen für Zähler aufbereiten
intWS = Worksheets.Count
lngRow = 1
intCol = 1
' Tabelle "Inhaltsverzeichnis" an letzter Stelle
' in der Mappe einfügen
Worksheets.Add After:=Worksheets(intWS)
Worksheets(intWS + 1).Name = "Inhaltsverzeichnis"
For i = 1 To intWS
' In jedem Tabellenblatt die Navigationszeile
' mit Link zum Inhaltsverzeichnis erstellen
With Worksheets(i)
' Alte Navigationszeile löschen
If .Range("A1").Value = "Inhaltsverzeichnis" Then
.Rows(1).Delete
End If
' Neue Navigationszeile einfügen
.Rows(1).Insert
.Hyperlinks.Add _
Anchor:=.Range("A1"), _
Address:="", _
SubAddress:="Inhaltsverzeichnis!A1", _
TextToDisplay:="Inhaltsverzeichnis"
' Hyperlinks im Tabellenblatt "Inhaltsverzeichnis"
' erstellen
Worksheets(intWS + 1).Hyperlinks.Add _
Anchor:=Cells(lngRow, intCol), _
Address:="", _
SubAddress:="'" & .Name & "'!A1", _
TextToDisplay:=.Name
' Bei 10 Einträgen die Spalte wechseln
If i Mod 10 = 0 Then
Worksheets(intWS + 1).Columns(intCol).AutoFit
intCol = intCol + 1
lngRow = 0
End If
End With
lngRow = lngRow + 1
Next i
' Tabelle "Inhaltsverzeichnis an erste Stelle verschieben
Worksheets("Inhaltsverzeichnis").Move Before:=Worksheets(1)
' Fensterfixierung festlegen
Call AddFreezePanes
' Das Tabellenblatt "Inhaltsverzeichnis" aktivieren
Worksheets(1).Activate
' Bildschirmaktualisierung wieder aktivieren
Application.ScreenUpdating = True
End Sub

Sub AddFreezePanes()
Dim i As Integer
Application.ScreenUpdating = False
For i = 2 To Worksheets.Count
Worksheets(i).Activate
Range("A2").Select
ActiveWindow.FreezePanes = True
Next i
Application.ScreenUpdating = True
End Sub

Sub DeleteFreezePanes()
Dim i As Integer
Application.ScreenUpdating = False
For i = 2 To Worksheets.Count
Worksheets(i).Activate
Range("A2").Select
ActiveWindow.FreezePanes = False
Next i
Application.ScreenUpdating = True
End Sub

Sub BlattSchutz()
' kennwort Makro
' Tastenkombination: Keine
Dim myPwd As String, myPwd2 As String
Dim wks As Worksheet
myPwd = Application.InputBox("Passwort eingeben")
myPwd2 = Application.InputBox("Wiederholung")
If myPwd2 = myPwd Then
For Each wks In ActiveWorkbook.Worksheets
wks.Protect Password:=myPwd, DrawingObjects:=True, _
Contents:=True, Scenarios:=True, AllowFormattingCells:=True, _
AllowFormattingColumns:=True, AllowFormattingRows:=True
Next wks
Else
MsgBox "Passwort falsch"
End If
End Sub

Sub freigeben()
' kennwort Makro
' Tastenkombination: Keine
Dim myPwd As String, myPwd2 As String
Dim wks As Worksheet
myPwd = Application.InputBox("Passwort eingeben")
myPwd2 = Application.InputBox("Wiederholung")
If myPwd2 = myPwd Then
For Each wks In ActiveWorkbook.Worksheets
wks.Unprotect Password:=myPwd
Next wks
Else
MsgBox "Passwort falsch"
End If
End Sub