şifre koyma kodunda hata

[OZCANLOK]

aşagıdaki koda ilk önce tüm sheet lerden şifreleri kaldırıp

ve en sonunda tekrar şifre koymak için hangi kodu yazmalıyım

teşekkürler

Private Sub Birol_Click()
Application.ScreenUpdating = False

Set s31 = Sheets("Genel Bilgiler")
Set s32 = Sheets("PLAN")
Set s33 = Sheets("FIYAT")
Set s34 = Sheets("BEDELSIZ")
Set s35 = Sheets("INSERT")
Set s36 = Sheets("TESHIR")


Dim SHEET As Object
For Each SHEET In Sheets
SHEET.Unprotect Password:="12345678"

s32.Visible = xlSheetVisible
Sheets("Bmc Takip").Visible = xlSheetVisible
s34.Visible = xlSheetVisible
s33.Visible = xlSheetVisible
s34.Visible = xlSheetVisible
s35.Visible = xlSheetVisible
s36.Visible = xlSheetVisible
Sheets("Ana Sayfa").Visible = xlSheetVeryHidden

s31.Visible = xlSheetVisible
s31.Select
Range("I11").Select
Selection.Copy
Range("j1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
s31.Visible = xlSheetVeryHidden

s32.Select
Columns("ah:ak").Select
Selection.EntireColumn.Hidden = False
s32.Select
Columns("at:aw").Select
Selection.EntireColumn.Hidden = False
s33.Select
Selection.AutoFilter Field:=2, Criteria1:="=Birol", Operator:=xlOr, _
Criteria2:="="
s34.Select
Selection.AutoFilter Field:=2, Criteria1:="=Birol", Operator:=xlOr, _
Criteria2:="="
s35.Select
Selection.AutoFilter Field:=2, Criteria1:="=Birol", Operator:=xlOr, _
Criteria2:="="
s36.Select
Selection.AutoFilter Field:=2, Criteria1:="=Birol", Operator:=xlOr, _
Criteria2:="="

Sheets("PLAN").Select
Range("J17").Select

SHEET.Protect Password:="12345678"

UserForm2.Hide

End Sub

 

[N.Ziya Hiçdurmaz]

yanıt

Kodların en başına şifre kaldırma ortaya diğer kodlar en sonuna şifre koyma.

Sub test()
ActiveSheet.Unprotect "123"
MsgBox "Tamam"
ActiveSheet.Protect "123"
End Sub

 

[tahsinanarat]

Ekteki dosyayı inceleyiniz

Ekteki dosya size fikir vermesi açısından inceleyiniz

 

[OZCANLOK]

İlginiz için teşekkürler işime çok yaradı