Kod ile koşullu satır ekleme

[tete58]

Arkadaşlar bir excel çalışma sayfasında A'dan S'ye kadar sutunlar mevcut ve 300 adet satır içerisinde veriler var ve sürekli çoğalabiliyor şimdi bana lazım olan B sutunundaki herhangi bir satırın karşısındaki N satırında ödendi yazıyor ise alta otomatik olarak bir satır eklenmesi örneğin B2 Hücresinde Ahmet Yazıyor ve Karşısındaki N2 Hücresindede Ödendi Yazıyor ise alta bir satır eklenecek kısacası N Sutununda bulunan hücrelerde ödendi yazıyor ise alta komple bir satır eklenmesini istiyorum yardım edecek arkadaşlara şimdiden çok teşekkür ederim.

 

[omerceri]

Sn tete58

Sub a()
say = Range("B65536").End(3).Row
For i = say To 1 Step -1
If Range("N" & i) = "Ödendi" Then
 Rows(i + 1).Insert Shift:=xlDown
End If
Next
End Sub

 

[tete58]

Sn tete58

Sub a()
say = Range("B65536").End(3).Row
For i = say To 1 Step -1
If Range("N" & i) = "Ödendi" Then
 Rows(i + 1).Insert Shift:=xlDown
End If
Next
End Sub

Hocam teşekkürler zahmet verdim

 

[tete58]

Sn tete58

Sub a()
say = Range("B65536").End(3).Row
For i = say To 1 Step -1
If Range("N" & i) = "Ödendi" Then
 Rows(i + 1).Insert Shift:=xlDown
End If
Next
End Sub

Ufak bir sorun oluştu şimdi Ödendi yazanların altına satır ekliyor sıkıntı yok ama ödeme yapmayıp sonradan ödeme yapanların karşısına ödendi diye yazdığımda hepsine tekrar bir satır daha ekliyor örneğin N2 hücresinde ödendi yazıyor onun altına bir satır ekliyor sorun yok ama N3 hücresinede ödendi yazdığım zaman makroyu çalıştırdığımda hem N3 ün altına satır ekliyor hemde N2 nin altına ikinci bir satır daha ekliyor böyle olursa her ödeme yapan kişi eklenince diğer ödeme yapanların altına sırayla bir çok satır eklenmiş olacak. bunu entera basarak düzenleyemezmiyiz yani N2 sutununda herhangi bir hücreye ödendi yazılıp entera bastığımızda altına bir satır eklese çok şeymi istemiş olurum

 

[omerceri]

Aşağıdaki odu deneyin.

Sub a()
say = Range("B65536").End(3).Row
For i = say To 1 Step -1
If Range("N" & i) = "Ödendi" and Range("B" &  i+1) = "" Then
 Rows(i + 1).Insert Shift:=xlDown
End If
Next
End Sub

 

[tete58]

Aşağıdaki odu deneyin.

Sub a()
say = Range("B65536").End(3).Row
For i = say To 1 Step -1
If Range("N" & i) = "Ödendi" and Range("B" &  i+1) = "" Then
 Rows(i + 1).Insert Shift:=xlDown
End If
Next
End Sub

Hocam bu kod ile hiç bir işlev yapmıyor biryerde yanlışlıkmı var acaba

 

[Korhan Ayhan]

Aşağıdaki kodu sayfanızın kod bölümüne uygulayıp deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo 10
    If Intersect(Target, Range("N2:N" & Rows.Count)) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    If UCase(Replace(Replace(Target, "ı", "I"), "i", "İ")) = "ÖDENDİ" Then
        If Target.Offset(1, 0) <> "" Then Target.Offset(1, 0).EntireRow.Insert
    End If
10  Application.EnableEvents = True
End Sub

 

[omerceri]

Mesajınızı Yeni gördüm kodu aşağıdaki gibi değiştirin. "=" işareti "<>" olacak

Sub a()
say = Range("B65536").End(3).Row
For i = say To 1 Step -1
If Range("N" & i) = "Ödendi" and Range("B" &  i+1) <> "" Then
 Rows(i + 1).Insert Shift:=xlDown
End If
Next
End Sub

 

[tete58]

Çok teşekkür ederim sorun düzeldi emeğinize sağlık