sayfa korumasında filtreleme ye izin verme

[kemal turan]

Merhaba,
Hocalarımızın yardımı ile aşağıdaki kod ile sayfa kopyalama ve yedek alma sorunumuzu çözdük.
ana dosyadan makro ile bu çalışma kitabını açıp verileri kopyalamak istiyorum. bu yolla bu kodu nasıl pasif edebilirim.
teşekkür ederim

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Sheets("sayfa1").Range("k1").Value = "x" Then
MsgBox "kapat butonunu kullanınız."
Cancel = True
Else
End If
End Sub

Private Sub Workbook_Open()
Sheets("sayfa1").Range("k1").Value = "x"
    EnableControl 21, False ' cut
    EnableControl 19, False ' copy
    EnableControl 22, False ' paste
    EnableControl 755, False ' pastespecial
    Application.OnKey "^c", ""
    Application.OnKey "^v", ""
    Application.OnKey "+{DEL}", ""
    Application.OnKey "+{INSERT}", ""
    Application.CellDragAndDrop = False
 
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    EnableControl 21, False ' cut
    EnableControl 19, False ' copy
    EnableControl 22, False ' paste
    EnableControl 755, False ' pastespecial
    Application.OnKey "^c", ""
    Application.OnKey "^v", ""
    Application.OnKey "+{DEL}", ""
    Application.OnKey "+{INSERT}", ""
    Application.CellDragAndDrop = False
End Sub
Sub EnableControl(Id As Integer, Enabled As Boolean)
    Dim CB As CommandBar
    Dim C As CommandBarControl
    For Each CB In Application.CommandBars
        Set C = CB.FindControl(Id:=Id, recursive:=True)
        If Not C Is Nothing Then C.Enabled = Enabled
    Next
End Sub

 

[kemal turan]

Aşağıdaki kod ile "af1" hücresinde Y harfi varsa kopyalama tuşu pasif oluyor.

Private Sub Workbook_Open()
If Sheets("VERILER").Range("AF1").Value = "Y" Then

EnableControl 21, True ' cut
    EnableControl 19, True ' copy
    EnableControl 22, True ' paste
    EnableControl 755, True ' pastespecial
    Application.OnKey "^c", ""
    Application.OnKey "^v", ""
    Application.OnKey "+{DEL}", ""
    Application.OnKey "+{INSERT}", ""
    Application.CellDragAndDrop = True
    Exit Sub
End If



Sheets("VERILER").Range("AE1").Value = "x"
    EnableControl 21, False ' cut
    EnableControl 19, False ' copy
    EnableControl 22, False ' paste
    EnableControl 755, False ' pastespecial
    Application.OnKey "^c", ""
    Application.OnKey "^v", ""
    Application.OnKey "+{DEL}", ""
    Application.OnKey "+{INSERT}", ""
    Application.CellDragAndDrop = False

End Sub

Fakat ağdaki başka bir bilgisayardan verileri almak istediğimde oluşturduğum makro ile "AF1" hücresine "Y" harfi yazdıran aşağıdaki kodu kullandığımda
istediğim fasif olayı olmuyor.
yardımlarınızı rica ediyorum.

Sub KDVERIAL()

    Workbooks.Open Filename:= _
        "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA\1_KD_DEDAGROUP.xlsm"
      Sheets("VERILER").Range("AF1").Value = "Y"
    
 
    
End Sub

 

[kemal turan]

Bu kodla önce hücreye Y yazıp kaydedip çıktım.
kod Y ha

Sub KDVERIYAZ()
Application.ScreenUpdating = False
    Workbooks.Open Filename:= _
        "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA\1_KD_DEDAGROUP.xlsm"
      Sheets("VERILER").Range("AF1").Value = "Y"
    Sheets("VERILER").Range("Ae1").Value = ""
  ActiveWorkbook.Save
    ActiveWindow.Close
    KDVERIAL
    Application.ScreenUpdating = True
End Sub
Sub KDVERIAL()
Application.ScreenUpdating = False
    Workbooks.Open Filename:= _
        "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA\1_KD_DEDAGROUP.xlsm"
Windows("0_TUM_ULKELERIN_OLD_ANA_DOSYA.xlsm").Activate
    Windows("1_KD_DEDAGROUP.xlsm").Activate
    Range("A2:O20").Select
    Range("O2").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("0_TUM_ULKELERIN_OLD_ANA_DOSYA.xlsm").Activate
    Sheets("KD").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B1").Select
    Windows("1_KD_DEDAGROUP.xlsm").Activate
    Sheets("VERILER").Range("AF1").Value = ""
    ActiveWindow.Close
    Sheets("anasayfa").Select
    MsgBox "KD SATICISININ VERİLERİ ALINDI.", , "VBA KT YAZILIM"
    Application.ScreenUpdating = True
End Sub

rfini gördüğünde mevcut kopyalama kodlarını pasif edip kopyalamaya izin verdi.
Çıkarken de aşağıdaki kod ile Y harfini sildim.