Sayfa ya yeni bir satır eklendiğinde aynı işlemin diğer sayfada da yapılması

[tamer42]

Merhaba,
Sayfa'ya ("Sayfa1") yeni bir satır eklendiğinde; (satır seç >> sağ click >> ekle)

yan sayfada "Sayfa2" aynı numaralı satıra da satır eklenmesini istiyordum, satır ekleme olayı ile ilgili aşağıdaki kodları buldum fakat düzenleme konusunda desteğe ihtiyacım bulunmakta;

ilginize şimdiden teşekkürler,

iyi çalışmalar.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Cells(Target.Row + Target.Rows.Count, Target.Item(1, 1).Column).ID = Target.Address
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Item(1, 1).ID <> "" Then
        MsgBox "deleted row"
    Else
        MsgBox "inserted row"
    End If
    Target.Item(1, 1).ID = ""
    Cells(Target.Row + Target.Rows.Count, Target.Item(1, 1).Column).ID = Target.Address
End Sub

 

[Korhan Ayhan]

Deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Item(1, 1).ID <> "" Then
        MsgBox "deleted row"
    Else
        Sheets("Sayfa2").Rows(Target.Row).Insert
        MsgBox "inserted row"
    End If
    Target.Item(1, 1).ID = ""
    Cells(Target.Row + Target.Rows.Count, Target.Item(1, 1).Column).ID = Target.Address
End Sub

 

[tamer42]

Deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Item(1, 1).ID <> "" Then
        MsgBox "deleted row"
    Else
        Sheets("Sayfa2").Rows(Target.Row).Insert
        MsgBox "inserted row"
    End If
    Target.Item(1, 1).ID = ""
    Cells(Target.Row + Target.Rows.Count, Target.Item(1, 1).Column).ID = Target.Address
End Sub

Korhan hocam çok teşekkürler,

şöyle bir durumda söz konusu;

"Kopyalanan hücreleri ekle" dediğimde 2 defa “inserted row” demekte; yani 2 defa satır eklemekte, bunun önüne nasıl geçebiliriz?

iyi Çalışmalar.

 

[Korhan Ayhan]

Eski kodları silip bunları deneyiniz.

Option Explicit
Dim Kontrol As Boolean

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Cells(Target.Row + Target.Rows.Count, Target.Item(1, 1).Column).ID = Target.Address
    Kontrol = False
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo 10
    If Kontrol = True Then
        Kontrol = False
        Exit Sub
    End If
    Application.EnableEvents = False
    If Target.Item(1, 1).ID <> "" Then
        MsgBox "deleted row"
    Else
        Sheets("Sayfa2").Rows(Target.Row).Insert
        MsgBox "inserted row"
    End If
    Target.Item(1, 1).ID = ""
    Cells(Target.Row + Target.Rows.Count, Target.Item(1, 1).Column).ID = Target.Address
    Kontrol = True
10  Application.EnableEvents = True
End Sub

 

[tamer42]

Eski kodları silip bunları deneyiniz.

Option Explicit
Dim Kontrol As Boolean

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Cells(Target.Row + Target.Rows.Count, Target.Item(1, 1).Column).ID = Target.Address
    Kontrol = False
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo 10
    If Kontrol = True Then
        Kontrol = False
        Exit Sub
    End If
    Application.EnableEvents = False
    If Target.Item(1, 1).ID <> "" Then
        MsgBox "deleted row"
    Else
        Sheets("Sayfa2").Rows(Target.Row).Insert
        MsgBox "inserted row"
    End If
    Target.Item(1, 1).ID = ""
    Cells(Target.Row + Target.Rows.Count, Target.Item(1, 1).Column).ID = Target.Address
    Kontrol = True
10  Application.EnableEvents = True
End Sub

Korhan hocam teşekkür ederim, yalnız kodlar hücreye bir şey yazdığımızda da çalışıyor,

sadece satır ekle, yada kopyalanan hücreleri ekle, yada satır sil durumunda çalışması için ne yapmak gerekir.
özetle herhangi bir hücre içi değiştiğinde çalışmasın

iyi çalışmalar.

 

[Korhan Ayhan]

Kodu siz paylaştınız.. Bende isteğinize uyarladım.

Paylaştığınız kodun aslında o menüyle bir alakası yok. Sayfada yapılan seçim ile hücrelerin ID özelliğine seçili satırın adres bilgisi yükleniyor. Eğer seçili satıra ekleme yaparsanız bu ID özelliği boş olacağı için kod sizin satır eklediğinizi yorumlayıp işlem yapıyor. Tam tersi ise satır silme işlemi için gerçekleşmektedir. Bir nevi pratik çözüm üretilmiş.

Kod Change olayına yazıldığı içinde sayfada yapacağınız her hücre değişiminden etkilenecektir.

Sizin istediğinizin tam olarak gerçekleşmesi için sağ klik menüsünde ki EKLE ve KOPYALANAN HÜCRELERİ EKLE seçeneklerine sizin tanımlayacağınız bir makronun atanması ile olabilir.

Aslında satır ekleme işlemini yaparken iki sayfayı seçerek yaparsanız makrosuz çözüme gidebilirsiniz.

 

[tamer42]

Sizin istediğinizin tam olarak gerçekleşmesi için sağ klik menüsünde ki EKLE ve KOPYALANAN HÜCRELERİ EKLE seçeneklerine sizin tanımlayacağınız bir makronun atanması ile olabilir.

Korhan hocam ben bu şekilde bir çözüm buldum, yani tekli hücre seçimlerinde kod devre dışı kalıyor, belki bunun öngöremedim başka mahsurları olabilir neyse;

sağ click' e makro ataması bana da pratik geldi; gerçekten bunu nasıl yapıyoruz? paylaşabileceğiniz bir döküman var mı?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Selection.Count < 100 Then
        Kontrol = True
        Exit Sub
    
    End If
    
    Cells(Target.Row + Target.Rows.Count, Target.Item(1, 1).Column).ID = Target.Address
    Kontrol = False
    
End Sub

iyi çalışmalar.

 

[Ömer]

Merhaba,

Sağ klik için: ( Hücre değil, satırda sağ klik için eklenmiştir. Ben bu şekilde algıladım)
Mevcut Ekle menüsünü pasif yapmak isterseniz Auto_ Open daki pasif kod satırını aktif yapınız.

Sub Auto_Open()
    Menu
    'Application.CommandBars("row").Controls("Ekle").Visible = False
End Sub

Sub Menu()

     Dim cb As CommandBar, MenuObject As Object
  
     Set cb = Application.CommandBars("row")
     Set MenuObject = cb.Controls.Add(Type:=msoControlButton, before:=7)
  
     With MenuObject
        .Caption = "Sayfalarda Satir Ekle"
        .OnAction = "deneme"
        .FaceId = 51
     End With
  
     Set cb = Nothing
     Set MenuObject = Nothing
  
End Sub

Sub Auto_Close()
    Application.CommandBars("row").Reset
End Sub

Sub deneme()
    Dim adr As String
    adr = Selection.Address
    Sheets("Sayfa1").Rows(adr).Insert Shift:=xlDown
    Sheets("Sayfa2").Rows(adr).Insert Shift:=xlDown
End Sub

 

[tamer42]

Merhaba,

Sağ klik için: ( Hücre değil, satırda sağ klik için eklenmiştir. Ben bu şekilde algıladım)
Mevcut Ekle menüsünü pasif yapmak isterseniz Auto_ Open daki pasif kod satırını aktif yapınız.

Sub Auto_Open()
    Menu
    'Application.CommandBars("row").Controls("Ekle").Visible = False
End Sub

Sub Menu()

     Dim cb As CommandBar, MenuObject As Object
 
     Set cb = Application.CommandBars("row")
     Set MenuObject = cb.Controls.Add(Type:=msoControlButton, before:=7)
 
     With MenuObject
        .Caption = "Sayfalarda Satir Ekle"
        .OnAction = "deneme"
        .FaceId = 51
     End With
 
     Set cb = Nothing
     Set MenuObject = Nothing
 
End Sub

Sub Auto_Close()
    Application.CommandBars("row").Reset
End Sub

Sub deneme()
    Dim adr As String
    adr = Selection.Address
    Sheets("Sayfa1").Rows(adr).Insert Shift:=xlDown
    Sheets("Sayfa2").Rows(adr).Insert Shift:=xlDown
End Sub

çok teşekkür ederim Ömer hocam