son satır nosuna göre 3,5,10 satır ekleme

uzmanamele

Uzman
Uzman
Katılım
26 Eylül 2007
Mesajlar
9,424
Excel Vers. ve Dili
excel 2010
merhaba
aşağıdaki kodlar ile toplam satırından 2 önceki satıra veri girişi yaptığımda alta 1 satır ekletiyorum.

son satırdan 2önceki satıra veri girişi yapıldığında;
son satır nosu 100 den büyükse 3 satır ekle
son satır nosu 75 den büyükse 5 satır ekle
son satır nosu 20 den büyükse 10 satır ekle

bu şartlar için mevcut kodlara nasıl bir ilave yapmam gerekir?


Private Sub Worksheet_Change(ByVal Target As Range)
Dim SON_SATIR As Long
If Intersect(Target, [C4:C65536]) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
SON_SATIR = [C65536].End(3).Row
If Target.Row = SON_SATIR - 2 And Target <> "" Then
Rows(Target.Row + 1).Copy
Rows((Target.Row + 1)).Insert Shift:=xlDown
Application.CutCopyMode = False
End If
End Sub
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,591
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

A&#351;a&#287;&#305;daki kodu denermisiniz.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Son_Sat&#305;r As Long
    If Intersect(Target, [C4:C65536]) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    Son_Sat&#305;r = [C65536].End(3).Row
    If Target.Row = Son_Sat&#305;r - 2 And Target <> "" Then
    Rows(Target.Row + 1).Copy
    If Son_Sat&#305;r > 100 Then
    Rows((Target.Row + 1) & ":" & (Target.Row + 4)).Insert Shift:=xlDown
    ElseIf Son_Sat&#305;r > 75 Then
    Rows((Target.Row + 1) & ":" & (Target.Row + 6)).Insert Shift:=xlDown
    ElseIf Son_Sat&#305;r > 20 Then
    Rows((Target.Row + 1) & ":" & (Target.Row + 11)).Insert Shift:=xlDown
    Else
    Rows((Target.Row + 1)).Insert Shift:=xlDown
    End If
    Application.CutCopyMode = False
    End If
End Sub
 

uzmanamele

Uzman
Uzman
Katılım
26 Eylül 2007
Mesajlar
9,424
Excel Vers. ve Dili
excel 2010
merhaba
syn Korhan Ayhan, tam istedi&#287;im gibi olmu&#351;, &#231;ok te&#351;ekk&#252;r ederim.
 
Üst