• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

kayıt aktarma makrosunda sayfa koruma sorunu

Katılım
12 Ocak 2007
Mesajlar
465
Excel Vers. ve Dili
2003
Sn Dostlar,daha önce yine bu siteden yardımlarla aldığım makro ile kayıtlarımı ilgili sayfaya aktarabiliyorum.ancak aktarma sonucu hedef sayfanın korumasız olması gerekiyor.koruma olursa bu makro işlemi yapamıyor.buna sayfa korumasını kaldır komutunu nereye yazabileceğim konusunda fikir verebilir ve yardımcı olursanız çok makbule geçecek.teşekürlerimle saygılar.


AKTARMA MAKROSU

Private Sub ÖLÜM_Click()
Dim ay1, AY2, i, J
i = 6
ay1 = Cells(2, 8).Value
Sheets(ay1).Range("A6:G50").ClearContents
Select Case ay1
Case "OCAK ÖLÜM": AY2 = 1
Case "ŞUBAT ÖLÜM": AY2 = 2
Case "MART ÖLÜM": AY2 = 3
Case "NİSAN ÖLÜM": AY2 = 4
Case "MAYIS ÖLÜM": AY2 = 5
Case "HAZİRAN ÖLÜM": AY2 = 6
Case "TEMMUZ ÖLÜM": AY2 = 7
Case "AĞUSTOS ÖLÜM": AY2 = 8
Case "EYLÜL ÖLÜM": AY2 = 9
Case "EKİM ÖLÜM": AY2 = 10
Case "KASIM ÖLÜM": AY2 = 11
Case "ARALIK ÖLÜM": AY2 = 12
End Select
Do While IsDate(Cells(i, 8))
If Month(Cells(i, 8)) = AY2 Then
Sheets("ÖLÜM DEFTERİ").Range("B" & i & ":G" & i).Copy
J = 6
Do While Sheets(ay1).Cells(J, 2) <> "" And Sheets(ay1).Cells(J, 4) <> ""
J = J + 1
Loop
For G = 6 To J
Sheets(ay1).Cells(G, 1) = G - 5
Next
Sheets(ay1).Range("B" & J & ":G" & J).PasteSpecial
End If
i = i + 1
Loop
Cells(6, 55).ClearContents
End Sub

ve eklemek ve tabi &#231;al&#305;&#351;t&#305;rmak istedi&#287;im sat&#305;r
ActiveSheet.Unprotect "0"
ActiveSheet.Protect "0"(bu kodunda en son &#231;al&#305;&#351;&#305;p sayfay&#305; korumas&#305;n&#305; istiyorum
 
Son düzenleme:
bu konunun sonunda yardımlarla çözülmüş ve düzeltilmiş dosyayı ekledim saygılarımla
 
Son düzenleme:
Say&#305;n mustafa7691,
denemedim ama,

ActiveSheet.Unprotect "0" komutunu butonun ilk sat&#305;r&#305;na,
ActiveSheet.Protect "0" komutunu butonun son sat&#305;r&#305;na koyarsan&#305;z san&#305;r&#305;m istedi&#287;inizi yapar.

Yani buton t&#305;kland&#305;&#287;&#305; anda sayfa korumas&#305; kald&#305;r&#305;l&#305;r, arada i&#351;lemler yap&#305;l&#305;r, ve buton i&#351;lemini yapt&#305;ktan sonra &#231;&#305;k&#305;l&#305;rken, tekrar sayfa korumaya al&#305;n&#305;r gibi.

Sayg&#305;lar...
 
Sn skorpiyon bunu defalarca denedim farkl&#305; yerlerdede u&#287;ra&#287;t&#305;m ama olmad&#305; makro tak&#305;l&#305;p i&#351;lemi sayfa korumas&#305; oldu&#287;u i&#231;in yapam&#305;yor.ben acaba kod i&#231;inde next veya and gibi bir ba&#287;la&#231; olmas&#305;m&#305; gerekiyor yada ba&#351;ka bir &#351;ekildemi olacak i&#231;inden &#231;&#305;kamad&#305;m.yinede ilginize te&#351;ekk&#252;rler.
 
Say&#305;n mustafa7691,

dosyan&#305;z&#305;n vba &#351;ifresi nedir ?
 
Siz OCAK &#214;L&#220;M sayfas&#305;n&#305; m&#305; yazd&#305;rmak istiyorsunuz?

Benim denemelerimde sayfa korumal&#305; oldu&#287;u halde gayet g&#252;zel &#231;al&#305;&#351;&#305;yor.
 
&#350;ahsen bende de gayet g&#252;zel &#231;al&#305;&#351;&#305;yor ama ???
 
Sn skorpiyon ben dosyay&#305; upload ederken k&#252;&#231;&#252;ltm&#252;&#351;t&#252;m sadece ocak ay&#305;na ait b&#246;l&#252;m aktif olmal&#305; yan&#305;lm&#305;yorsam.yani sadece &#246;l&#252;m defterinden ocak ay&#305; &#246;l&#252;mlerini ocak ay&#305; listesine aktarabilir &#351;u haliyle.te&#351;ekk&#252;rlerimle
 
nas&#305;l &#231;al&#305;&#351;&#305;yor ocak ay&#305; &#246;l&#252;mlerini ocak ay&#305; listesi (sayfas&#305; korumal&#305;yken) kaydet komutu &#231;al&#305;&#351;&#305;yormu yani
 
ocak &#246;l&#252;m sayfas&#305;n&#305; korumaya al&#305;rsan&#305;z &#231;al&#305;&#351;mad&#305;&#287;&#305;n&#305; g&#246;receksiniz.
 
Siz ilk sorunuzda print makrosunun kodlar&#305;n&#305; yazm&#305;&#351;s&#305;n&#305;z. Bizde print kodlar&#305;nda hata ar&#305;yoruz..
 
Sn ripek ben defter sayfas&#305;ndan ocak &#246;l&#252;m sayfas&#305; korumal&#305;yken(ki sizdekinde korumal&#305; de&#287;il)kaydet makrosu ile &#246;l&#252;mleri aktaram&#305;yorum sayfa korumal&#305; hatas&#305; veriyor.sorunum makronun bu korumay&#305; a&#351;&#305;p i&#351;i bitince tekrar korumay&#305; koymas&#305; sayg&#305;lar&#305;mla
 
evet hakl&#305;s&#305;n&#305;z ben &#231;ok &#231;ok &#246;z&#252;r diliyorum sorum do&#287;ru ama yazd&#305;&#287;&#305;m makro hatal&#305; aff&#305;n&#305;z&#305; diliyorum
 
Kod:
Private Sub &#214;L&#220;M_Click()
Dim ay1, AY2, i, J
i = 6
ay1 = Cells(2, 8).Value
[b]Sheets(ay1).Unprotect "0"[/b]
Sheets(ay1).Range("A6:G50").ClearContents
Select Case ay1
Case "OCAK &#214;L&#220;M": AY2 = 1
Case "&#350;UBAT &#214;L&#220;M": AY2 = 2
Case "MART &#214;L&#220;M": AY2 = 3
Case "N&#304;SAN &#214;L&#220;M": AY2 = 4
Case "MAYIS &#214;L&#220;M": AY2 = 5
Case "HAZ&#304;RAN &#214;L&#220;M": AY2 = 6
Case "TEMMUZ &#214;L&#220;M": AY2 = 7
Case "A&#286;USTOS &#214;L&#220;M": AY2 = 8
Case "EYL&#220;L &#214;L&#220;M": AY2 = 9
Case "EK&#304;M &#214;L&#220;M": AY2 = 10
Case "KASIM &#214;L&#220;M": AY2 = 11
Case "ARALIK &#214;L&#220;M": AY2 = 12
End Select
Do While IsDate(Cells(i, 8))
If Month(Cells(i, 8)) = AY2 Then
Sheets("&#214;L&#220;M DEFTER&#304;").Range("B" & i & ":G" & i).Copy
J = 6
Do While Sheets(ay1).Cells(J, 2) <> "" And Sheets(ay1).Cells(J, 4) <> ""
J = J + 1
Loop
For G = 6 To J
Sheets(ay1).Cells(G, 1) = G - 5
Next
Sheets(ay1).Range("B" & J & ":G" & J).PasteSpecial
End If
i = i + 1
Loop
Cells(6, 55).ClearContents
[b]Sheets(ay1).Protect "0"[/b]
End Sub

olarak deneyiniz.
 
Sn ripek ve ilgilenen t&#252;m dostar&#305;m.sorunum sn ripek'in yard&#305;m&#305;yla a&#351;&#305;ld&#305; te&#351;ek&#252;rlerim ve sayg&#305;lar&#305;mla
 
ilginiz ve bilginiz i&#231;in sizede &#231;ok te&#351;ekk&#252;rler Sn scorpiyon sayg&#305;lar&#305;mla
 
Geri
Üst