Blattschutz und Makro: ActiveSheet.Unprotect bzw. ... .Protect funktionieren nicht

Question

Hallo,

mal wieder ein Excel-Problem:

ich habe eine Tabelle mit diversen Tabellenblättern.
Zum Schutz einiger Daten sind teils ganze Tabellenblätter und auch Spalten mit einem Schutz versehen,

Mein Makro (der Arbeitsmappe) funktioniert dadurch leider nicht mehr. Auch das Einfügen von
ActiveSheet.Unprotect
ActiveShett.Protect
löst mein Problem nicht (an falscher Stelle eingefügt ???)

Hier das Makro:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

ActiveSheet.Unprotect

Application.EnableEvents = False

If Target.Column = 10 Then
With ThisWorkbook.Worksheets(Sh.Index)
zeile = ThisWorkbook.Worksheets("Behandlungen").Range("A" & Rows.Count).End(xlUp).Row + 1
ThisWorkbook.Worksheets("Behandlungen").Range("A" & zeile) = .Range("O3")
ThisWorkbook.Worksheets("Behandlungen").Range("B" & zeile) = .Range("O4")
.Range("A" & Target.Row & ":G" & Target.Row).Copy
ThisWorkbook.Worksheets("Behandlungen").Range("C" & zeile).PasteSpecial Paste:=xlValues, Operation:=xlNone
End With
Application.CutCopyMode = False
End If
Application.EnableEvents = True

ActiveSheet.Protect

End Sub


Erwähnen sollte ich noch:
Es gibt noch 2 weitere Makros (im Modul), die dafür sorgen den Schutz mit einem Klick aufzuheben, beeinflussen diese evtl. das obrige Makro ??

Sub Alle_Arbeitsblätter_schützen()
Dim s
Dim Name As Variant
Name = ActiveSheet.Name
Application.ScreenUpdating = False

For s = 1 To Sheets.Count
Sheets(s).Select
ActiveSheet.Protect
Next s
Sheets(Name).Select
Application.ScreenUpdating = True
End Sub

Sub Alle_Arbeitsblätter_Schutz_aufheben()
Dim s
Dim Name As Variant
Name = ActiveSheet.Name
Application.ScreenUpdating = False

For s = 1 To Sheets.Count
Sheets(s).Select
ActiveSheet.Unprotect
Next s
Sheets(Name).Select
Application.ScreenUpdating = True
End Sub


Bin für jede Hilfe dankbar ....

Viele Grüße - Petra

Answer 1

an falscher Stelle eingefügt ???

Glaub ja.
Du hebst den Schutz (des aktuellen) Tabellenblattes auf und startest dann die With-Schleife, die mehrere Tabellenblätter der Arbeitsmappe bearbeitet.
Probiere mal, die Anweisungen für Schutz aufheben und schützen inerhalb der With-Schleife zu platzieren.
Alternativ kannst du auch vor dem Makro den Schutz auf allen Tabellenblättern aufheben, dann Makro abarbeiten und vor dem Ende wieder alle schützen.

Gruß Flupo

Answer 2

Hallo,

ich glaube Du hast recht, nur leider komme ich nicht auf die Lösung, habe es innerhalb der Schleifer versucht ... ohne Erfolg ;-)


Werde es nachher in Ruhe nochmals angehen - vielen Dank und viele Grüße

Petra

Answer 3

Halo Petra,

Option Explicit

Sub Alle_Arbeitsblätter_schützen()
Dim s
Application.ScreenUpdating = False
For s = 1 To Sheets.Count
Sheets(s).Protect
Next s
Application.ScreenUpdating = True
End Sub

Sub Alle_Arbeitsblätter_Schutz_aufheben()
Dim s
Application.ScreenUpdating = False
For s = 1 To Sheets.Count
Sheets(s).Unprotect
Next s
Application.ScreenUpdating = True
End Sub

Gruß Hajo

Answer 4

Hallo,

@Hajo: vielen Dank ... habe ich total übersehen ...;-(

und nach vielem grübeln bin ich auch auf die Lösung gekommen,
die Anmerkung von Flupo war richtig, ich musste tatsächlich in der While-Schleife den Schutz aufheben, und habe ihn dann nach der Schleife wieder gesetzt. Nun funktioniert es einwandfrei ... ;-)

Vielen, vielen Dank und viele Grüße

Petra