Belli sayfalara koruma koyma kaldırma

[klop01]

Arkadaşlar,
Bir çalışma kitabındaki belli sayfalara koruma koyan ve kaldıran iki kodum var.

1. Bu kodları belli sayfalarda çalışır yapmak için ne yapmalıyım? Örnek dosyada sayfa adları var.
2. Örnek dosyadaki Sayfa_Korumalarını_Kaldır kodu çalıştırılınca içerisinde bulunduğum sayfadan başka sayfaya gönderiyor. Bunu çözebilir miyiz?

Yukarıdaki iki sorun için yardımlarınızı rica ediyorum.

Sub Sayfa_Korumalarını_Kaldır()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Unprotect
Next
End Sub

Sub Sayfaları_Koru()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True, AllowFormattingColumns:=True
Next
End Sub

 

[Muzaffer Ali]

Merhaba.
Module1 deki kodları silin aşağıdakileri ekleyin.

Dim ws As Variant
Dim Bak As Integer

Sub Sayfa_Korumalarını_Kaldır()
    Application.ScreenUpdating = False
    Sayfalar
    For Bak = 0 To UBound(ws)
        Worksheets(ws(Bak)).Unprotect
    Next
    Worksheets("BAŞLANGIÇ").Select
    Application.ScreenUpdating = True
End Sub
Sub Sayfaları_Koru()
    Sayfalar
    For Bak = 0 To UBound(ws)
        Worksheets(ws(Bak)).Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True, AllowFormattingColumns:=True
    Next
End Sub

Sub Sayfalar()
    ws = Array("OCAK", "ŞUBAT", "MART")
End Sub

("OCAK", "ŞUBAT", "MART") kısmına sayfa adı ekleyip çıkarabilirsiniz

 

[klop01]

Muzaffer Ali,
Yardımınız için teşekkürler.
İnternetten aşağıdaki kodu bulup sorunu çözmüştüm.
Kodunuzla ilgili bir şey dikkatimi çekti: Hem koruma hem de koruma kaldırma MART ayı sayfasında işlem yapmıyor.

Sub Sayfa_Korumalarını_Kaldır()
For i = 2 To 4     '2, 3 ve 4. sekmedeki sayfaların korumasını kaldıracak.
Sheets(i).Unprotect
Next i
End Sub
Sub Sayfaları_Koru()
For i = 2 To 4     '2, 3 ve 4. sekmedeki sayfaları korumaya alacak.
Sheets(i).Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True, AllowFormattingColumns:=True
Next i
End Sub

 

[Muzaffer Ali]

Kodu düzelttim şimdi doğru çalışıyor.