Her satır açtığımda çalışması gereken makro

[umitumit]

Arkadaşlar merhaba,

Aşağıdaki gibi Ctrl+Shift+Y ile çalışan bir makrom var.
Ben bu makromun sayfaya her satır açtığımda otomatik çalışmasını istiyorum.

Yardımı olacak arkadaşlara şimdiden teşekkürler



Sub SATIR_EKLEME()
'
' SATIR_EKLEME Makro
' YENİ SATIR EKLEME
'
' Klavye Kısayolu: Ctrl+Shift+Y

Dim i As Integer
Dim satir

Rows(ActiveCell.Row).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Application.CutCopyMode = False

For i = 1 To 20
Select Case i
Case 1 To 6
Cells(ActiveCell.Row - 1, i).Copy
Cells(ActiveCell.Row, i).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Case 9 To 10
Cells(ActiveCell.Row - 1, i).Copy
Cells(ActiveCell.Row, i).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Case 17 To 20
Cells(ActiveCell.Row - 1, i).Copy
Cells(ActiveCell.Row, i).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Select
Next i

Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 2)).Select
satir = ActiveCell.Row

Selection.Copy

Range(Cells(ActiveCell.Row + 1, 1), Cells(ActiveCell.Row + 1, 2)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste

Cells(satir + 1, 3).Select
Application.CutCopyMode = False
End Sub

 

[askm]

Örnek dosya görerek çözüm üretilebilir. Son satır numarası bir yere kaydedilir. O değer arttıkça makro çalışabilir.