VBA-Code wird nicht ausgeführt
22.12.2021 15:03:10
Erwin
ich habe eine größere Datei mit u.a. 52 KW, in denen ich mehrere Bereiche beschreibbar und den Rest sperren lasse.
Mit großer Unterstützung dieses Forums habe ich mir folgenden Code zusammengebastelt, der auch funktioniert:
Sub KW_sperren()
'Alle Register KWen sperren bis auf die beschreibbaren Bereiche
Dim ws As Worksheet
Dim bebereich1 As Range 'offener beschreibbarer Bereich bis Zelle P104
Dim bebereich2 As Range 'offener beschreibbarer Bereich bis Zelle P146
'Alle 52 KW werden durchlaufen
For Each ws In Worksheets
If ws.Name Like "*KW" Then
With ws
'Beschreibbare Zellen in der ersten Bereichs-Variablen
Set bebereich1 = Union(.Range("A4:G4"), .Range("A7:P8"), .Range("A10:G10"), .Range("A13:P14"), .Range("A16:G16"), .Range("A19:P20"), .Range("A25:G25"), .Range("A28:P29"), _
.Range("A31:G31"), .Range("A34:P35"), .Range("A37:G37"), .Range("A40:P41"), .Range("A46:G46"), .Range("A49:P50"), .Range("A52:G52"), .Range("A55:P56"), _
.Range("A58:G58"), .Range("A61:P62"), .Range("A67:G67"), .Range("A70:P71"), .Range("A73:G73"), .Range("A76:P77"), .Range("A79:G79"), .Range("A82:P83"), _
.Range("A88:G88"), .Range("A91:P92"), .Range("A94:G94"), .Range("A97:P98"), .Range("A100:G100"), .Range("A103:P104"))
bebereich1.Locked = False 'Diesen Bereich nicht sperren
bebereich1.FormulaHidden = False
'Da in der Union-Methode nur 30 Argumente zulässig sind, muss eine weitere Bereichs-Variable für die restlichen beschreibbaren Zellen deklariert werden
Set bebereich2 = .Range("A109:G109,A112:P113,A115:G115,A118:P119,A121:G121,A124:P125,A130:G130,A133:P134,A136:G136,A139:P140,A142:G142,A145:P146")
bebereich2.Locked = False 'Diesen Bereich nicht sperren
bebereich2.FormulaHidden = False
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
End If
Next ws
End Sub
Sub KW_sperren()
'Alle Register KWen sperren
Dim ws As Worksheet
For Each ws In Worksheets
If ws.name Like "*KW" Then
With ws.Range("A2:P146") 'Diesen Bereich
.Locked = False 'nicht sperren
.FormulaHidden = False
End With
ws.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
Next ws
End Sub
Ich habe in der Originaldatei schon alle anderen Prozeduren gelöscht und nur den neuen eingefügt und ausgeführt. Aber es wird immer nur der alte ausgeführt, also der mit dem ganzen Bereich, obwohl der im VBA-Editor gar nicht mehr existiert.
Habe auch einzele KW-Tabellenblätter von der Originaldatei in die Testdatei kopiert, aber auch hier wird immer nur der alte ausgeführt.
Wie kann denn so was sein?
Hat jemand eine Idee, wäre super
Schöne Grüße
Erwin