Makro ile sayfaları koruma-açma

[enes2000eren]

SLM.ARKADAŞLAR

1-MAKRO İLE 1-50 ARASINDAKİ SAYFALARI BİR BUTON YARDIMI İLE KORUMAK VEYA KORUMASINI İPTAL ETMEK MÜMKÜN MÜDÜR?

2-AŞAĞIDAKİ MAKRO İLE DİĞER SAYFALARDAN BİLGİLERİ AKTARABİLİYORUM.FAKAT BEN SADECE 1-50 ARASINDAKİ SAYFALARDAN BİLGİ AKTARILMASINI İSTİYORUM.DİĞER SAYFALARDAN DEĞİL

"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Sub AKTAR2()
Call TEMIZLE2
Dim sat, i
s = 3
Sheets("EGZERSIZ").[A3:AL501] = Empty
Application.ScreenUpdating = False
For i = 1 To Sheets.Count
For sat = 347 To Sheets(i).Cells(355, "A").End(xlUp).Row
If Sheets(i).Name <> Sheets("EGZERSIZ").Name Then
Range(Sheets("EGZERSIZ").Cells(s, "A"), Sheets("EGZERSIZ").Cells(s, "AL")) = _
Range(Sheets(i).Cells(sat, "A"), Sheets(i).Cells(sat, "AL")).Value
s = s + 1
End If
Next: Next
Application.ScreenUpdating = True
Call MODEL2
Call GIZLE2
End Sub

 

[İhsan Tank]

merhaba

SAYFA KORUMA MENÜSÜ ÇAĞIR
Sub BlattSchutzEin()
Application.Dialogs(xlDialogProtectDocument).Show
End Sub

SAYFA KORUMASINI KALDIR MENÜSÜ
Sub BlattSchutzAus()
ActiveSheet.Unprotect
End Sub

bu kodları denermisin ( kodlar alıntıdır )

 

[enes2000eren]

Sayın çılgın 86 yazmış olduğunuz makro koruma yapıyor fakat ben aynı adna 1-50 arasındaki sayfaları korumak istiyorum.

 

[İhsan Tank]

arkadaşım birde bunu dener misin ben tam olarak makroları bilmiyorum ama paylaştığım makrolar bura paylaşılan makrolardır.
Private Sub Worksheet_Activate()
Range("A65536").Select
If InputBox("şifre Gir?", "şifre") = "123" Then
Range("A1").Select
Else
MsgBox ("şifre Yanlış")
Sheets("Sayfa1").Select
End If
End Sub ' Sayfayı gizleyin. (Biçim/Sayfa/Gizle)
sonra açılış makrusuna şu kodu ekleyin
Kod:

Sub Autpen()
Sheets("Gizli Sayfa").Visible = True
End Sub

Burada mantık şu Makrolar etkinleştirlmesse sayfa görünmez.
Etkinleştirldiğinde ise o sayfaya tıklandığında sayfanın kod böülümüne şu kodu ekleyin

Kod:

Private Sub Worksheet_Activate()
Dim sifre
Dim durum
git:
sifre = Application.InputBox("Lütfen Kullanıcı Kodunu Giriniz", _
"Sayın ; " & Application.UserName, "şifre")
If sifre = Empty Then Sheets("DiğerSayfa").Select
If sifre <> "şifre" Then
durum = MsgBox("Girdiğiniz şifre Yanlıştır " _
& vbNewLine & "Lütfen doru şifre giriniz." _
& vbNewLine & "Tekrar şifre Girmek İstiyormusunuz", vbYesNo, Application.UserName)
If durum = vbYes Then GoTo git
Else
MsgBox "şifre Doğrudur.....!", vbInformation, Application.UserName
Exit Sub
End If
Sheets("DiğerSayfa").Select
End Sub

bu kod alıntıdır

 

[Orion1]

Sub sayfalari_koru()
Dim sh As Worksheet
For Each sh In Worksheets
    sh.Protect
Next
End Sub

Sub korumayi_kaldir()
Dim sh As Worksheet
For Each sh In Worksheets
    sh.Unprotect
Next
End Sub

 

[enes2000eren]

sub sayfalari_koru()
dim sh as worksheet
for each sh ın worksheets
    sh.protect
next
end sub

sub korumayi_kaldir()
dim sh as worksheet
for each sh ın worksheets
    sh.unprotect
next
end sub

tşk.evrenbey istediğim gibi.

 

[enes2000eren]

EVREN BEY AŞAĞIDAKİ MAKRO İLE DİĞER SAYFALARDAN BİLGİLERİ AKTARABİLİYORUM.FAKAT BEN SADECE 1-50 ARASINDAKİ SAYFALARDAN BİLGİ AKTARILMASINI İSTİYORUM.DİĞER SAYFALARDAN DEĞİL

"""""""""""""""""""""""""""""""""""""""""""""""""" """""""""""""""""""""""""""""""""""""""""""""" "
Sub AKTAR2()
Call TEMIZLE2
Dim sat, i
s = 3
Sheets("EGZERSIZ").[A3:AL501] = Empty
Application.ScreenUpdating = False
For i = 1 To Sheets.Count
For sat = 347 To Sheets(i).Cells(355, "A").End(xlUp).Row
If Sheets(i).Name <> Sheets("EGZERSIZ").Name Then
Range(Sheets("EGZERSIZ").Cells(s, "A"), Sheets("EGZERSIZ").Cells(s, "AL")) = _
Range(Sheets(i).Cells(sat, "A"), Sheets(i).Cells(sat, "AL")).Value
s = s + 1
End If
Next: Next
Application.ScreenUpdating = True
Call MODEL2
Call GIZLE2
End Sub

 

[Orion1]

EVREN BEY AŞAĞIDAKİ MAKRO İLE DİĞER SAYFALARDAN BİLGİLERİ AKTARABİLİYORUM.FAKAT BEN SADECE 1-50 ARASINDAKİ SAYFALARDAN BİLGİ AKTARILMASINI İSTİYORUM.DİĞER SAYFALARDAN DEĞİL

"""""""""""""""""""""""""""""""""""""""""""""""""" """""""""""""""""""""""""""""""""""""""""""""" "
Sub AKTAR2()
Call TEMIZLE2
Dim sat, i
s = 3
Sheets("EGZERSIZ").[A3:AL501] = Empty
Application.ScreenUpdating = False
For i = 1 To Sheets.Count
For sat = 347 To Sheets(i).Cells(355, "A").End(xlUp).Row
If Sheets(i).Name <> Sheets("EGZERSIZ").Name Then
Range(Sheets("EGZERSIZ").Cells(s, "A"), Sheets("EGZERSIZ").Cells(s, "AL")) = _
Range(Sheets(i).Cells(sat, "A"), Sheets(i).Cells(sat, "AL")).Value
s = s + 1
End If
Next: Next
Application.ScreenUpdating = True
Call MODEL2
Call GIZLE2
End Sub

bu konu kapandı yeni bir başlık açarak sorunuzu sorunuz.