İki sayfaya birden satır ekleme

[Sarigol_937]

merhaba arkdaşlar benim elimde excel çalışma kitabımda sayfa1 ve Sayfa 2 diye iki sayfa var ve ben burda sayfa 1 de herhangibi bir satıra sağ tuşu tıklayıp ekle dediğimde sayfa2 de aynı satıra 2(iki) tane satır eklenmesini istiyorum bunun için herhangibi bir visual basic kod oluşturulabilirmi?

 

[Murat OSMA]

Şu kodları sayfanın kod kısmına yapıştırıp satırda çift tıklayın;

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    On Error Resume Next
    Rows(Target.Row & ":" & Target.Row).Insert Shift:=xlDown
    Sayfa2.Rows(Target.Row & ":" & 2 + Target.Row - 1).Insert Shift:=xlDown
    Cancel = True
End Sub

 

[Sarigol_937]

Kardeş çok sağol ancak çift tıklama ile satır ekleme yerine herhangibi bir tuş atasak olmazmı F6, F5 gibi

 

[Sarigol_937]

çift tıklama işlemini çok fazla kullanıyorum sıkıntı çıkarır

 

[Murat OSMA]

Onkey metodunu araştırıp yapabilirsiniz.

 

[Sarigol_937]

anladım çok sağolun yardımlarınız için

 

[Sarigol_937]

murat bey tuş atamayı yapamadım ben bari bu çift tıklayacağımız alanı seçip buton gibi bişiyolsa tıklayonca o alana ve ikinci sayfaya eklense

 

[Sarigol_937]

Sub satirekle()
x = InputBox("Satır eklemek için Lütfen Satır Numarasını giriniz ", "Lütfen Yalnızca Sayı Giriniz ")
If Not IsNumeric(x) Or x <= 1 Then
MsgBox "Numerik olmayan yada hatalı değer girdiniz ", vbOKOnly, "D İ K K A T !"
Exit Sub
End If
If MsgBox(x & " . Satira Ekliyorum", vbCritical + vbYesNo, "uyarı") = vbYes Then
Set s1 = Worksheets("1")
Set s2 = Worksheets("2")
Set s3 = Worksheets("3")
s1.Select
'x = Range("A65536").End(3).Row
Cells(x, "A").Select
ActiveCell.EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=x1FormatFromLeftOrAbove
s2.Select
'x = Range("A65536").End(3).Row
Cells(x, "A").Select
ActiveCell.EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

s3.Select
'x = Range("A65536").End(3).Row
Cells(x, "A").Select
ActiveCell.EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
s1.Select

End If
End Sub
Sub satirsil()
'
' satirsil Makro
'

'
x = InputBox("Satır silmek için Lütfen Satır Numarasını giriniz ", "Lütfen Yalnızca Sayı Giriniz ")
If Not IsNumeric(x) Or x <= 1 Then
MsgBox "Numerik olmayan yada hatalı değergirdiniz ", vbOKOnly, " D İ K K A T !"
Exit Sub
End If

If MsgBox(x & " . Satiri siliyorum", vbCritical + vbYesNo, "uyarı") = vbYes Then

Set s1 = Worksheets("1")
Set s2 = Worksheets("2")
Set s3 = Worksheets("3")

s1.Select
'x = Range("A65536").End(3).Row - 1
Cells(x, "A").Select
ActiveCell.EntireRow.Select
Selection.Delete Shift:=xlUp
s2.Select
'x = Range("A65536").End(3).Row - 1
Cells(x, "A").Select
ActiveCell.EntireRow.Select
Selection.Delete Shift:=xlUp
s3.Select
'x = Range("A65536").End(3).Row - 1
Cells(x, "A").Select
ActiveCell.EntireRow.Select
Selection.Delete Shift:=xlUp
s1.Select

End If

End Sub

bu kodda satır ekle deyince satır numarasını verdiğimiz satırların hepsine 3 sayfadada birer satır ekliiyor bu formülü 1.sayfaya 1 satır 2 sayfaya 2 satır eklencek şekilde revize edebilme imkanı varmı

 

[Murat OSMA]

Onkey metodu ile tuşa makro atayabilirsiniz.