VBA Kod yardımı

[Mehmet Sait]

Merhabalar,

Tüm sayfalara şifre koyulması için şu kodu kullanıyorum.

For Each Sheet In Worksheets
Sheet.Protect Password:="3300"
Next Sheet

Ancak A ve B isimli sayfaları şifreleme dışında tutmak istiyorum. Ne gibi değişiklik yapmalıyım ?

Yardımlarınız için teşekkür ederrim.

 

[Muzaffer Ali]

Merhaba.

For Each Sheet In Worksheets
    If Not Sheet.Name = "A" Or Not Sheet.Name = "B" Then
        Sheet.Protect Password:="3300"
    End If
Next Sheet

 

[Mehmet Sait]

Merhaba.

For Each Sheet In Worksheets
    If Not Sheet.Name = "A" Or Not Sheet.Name = "B" Then
        Sheet.Protect Password:="3300"
    End If
Next Sheet

Hocam, yardımlarınız için teşekkür ederim.

 

[Mehmet Sait]

Merhaba.

For Each Sheet In Worksheets
    If Not Sheet.Name = "A" Or Not Sheet.Name = "B" Then
        Sheet.Protect Password:="3300"
    End If
Next Sheet

Hocam, dediğiniz gibi yaptım ama yinede şifreliyor. Kodlarda şifrelemeyi tetikleyen kısım mı var acaba ?

Private Sub CommandButton1_Click()
    Worksheets("BOŞ_TASLAK").Unprotect "3300"

    Application.ScreenUpdating = False
    Dim Sayfa As String
    Dim SY As Worksheet
    Set SY = Sheets("ANA")
    Dim SB As Worksheet
    Set SB = Sheets("BOŞ_TASLAK")
    
    For a = 3 To SY.[A65536].End(3).Row
        Sayfa = SY.Cells(a, "A")
        
    If SY.Cells(a, "B") <> "Aktarıldı" Then
        If SY.Cells(a, "A") <> "" Then
            If Not SayfaVarMi(Sayfa) Then
                SB.Copy After:=Sheets(Sheets.Count)
                ActiveSheet.Name = Sayfa
            Else
            End If
        End If
        
        sonsat = Sheets(Sayfa).[B65536].End(3).Row + 2
        SY.Range("B" & a & ":AM" & a).Copy Sheets(Sayfa).Cells(sonsat, "A")
        SY.Cells(a, "B") = "Aktarıldı"
    End If
    Next a
    
    SY.Select
    Application.ScreenUpdating = True
    MsgBox " B i t t i "

'***********
For Each Sheet In Worksheets
    If Not Sheet.Name = "Üretim" Or Not Sheet.Name = "Satışlar" Then
        Sheet.Protect Password:="3300"
    End If
Next Sheet
'**********************
Worksheets("ANA").Unprotect "3300"
Worksheets("BOŞ_TASLAK").Unprotect "3300"
Worksheets("BOŞ_TASLAK").Protect "3300"
Sheets(CStr(Date - 1)).Select

End Sub
Function SayfaVarMi(Sayfa As String) As Boolean
    On Error Resume Next
    SayfaVarMi = CBool(Len(Worksheets(Sayfa).Name) > 0)
End Function
Private Sub CommandButton2_Click()
Dim syf
Application.ScreenUpdating = False
On Error Resume Next
Application.DisplayAlerts = False
döngü:
For syf = 1 To Worksheets.Count
    If Worksheets(syf).Name = "ANA" Or Worksheets(syf).Name = "BOŞ_TASLAK" Or Worksheets(syf).Name = "Üretim" Or Worksheets(syf).Name = "Satışlar" Then GoTo pass    'yazılan sayfa pas geçiliyor
    Worksheets(syf).Delete
    GoTo döngü:
pass:
Next syf
Application.DisplayAlerts = True

    Sheets("ANA").Select
    Range("A2:B380").Select
    Selection.ClearContents
    Range("A3").Select

End Sub

 

[numan şamil]

Merhaba
kodlarının sonuna ekleyip denermisiniz
For Each Sheet In Worksheets
If Sheet.Name = "A" Or Sheet.Name = "B" Then
Sheet.Unprotect Password:="3300"
End If
Next Sheet

 

[Mehmet Sait]

Merhaba
kodlarının sonuna ekleyip denermisiniz
For Each Sheet In Worksheets
If Sheet.Name = "A" Or Sheet.Name = "B" Then
Sheet.Unprotect Password:="3300"
End If
Next Sheet

Hocam, alakanız için teşekkür edrim. Denedim ama yine olmadı

 

[Lenadro]

Merhaba @dunya

Çalışmanıza yardım edebilmek adına dosyayı yükler misiniz ?

 

[Mehmet Sait]

Merhaba @dunya

Çalışmanıza yardım edebilmek adına dosyayı yükler misiniz ?

Merhaba hocam, sorunu şu şekilde hallettim,

For Each Sheet In Worksheets
Sheet.Protect Password:="3300"
Next Sheet
Worksheets("ANA").Unprotect "3300"
Worksheets("BOŞ_TASLAK").Unprotect "3300"
Worksheets("BOŞ_TASLAK").Protect "3300"
Worksheets("Üretim").Unprotect "3300"
Worksheets("Sevkiyat İrsaliye").Unprotect "3300"
Worksheets("Faturalanan Satışlar").Unprotect "3300"

örnek dosyayı ekliyorum. Yardımlarınız için teşekkür ederim.