Satır ve numara ekleme

[xemdarx]

Selamlar,
Yazdıkça alt satır ve numara ekleyebilir miyiz? Silindiğinde de satır kaldırılsın. Teşekkürler

 

[xemdarx]

Yardımlarınızı bekliyorum.

 

[Muzaffer Ali]

Dosyanız ekte.

 

[xemdarx]

Zahmet ettiniz. Lakin istediğim gibi olmamış. Her hücreye yazdığımda yeni satır ekliyor. Satır da silinmiyor.

 

[Muzaffer Ali]

Hangi hücreye yazdığında satır eklesin?
Hangi hücreyi sildiğinde satır silsin?

 

[xemdarx]

E sütunundaki hücrelere. İsim silinince satır da silinsin. Eklenince sona satır eklensin.Ayrıca aradan isim silsek yeniden numara verilir mi?

 

[Muzaffer Ali]

Gönderdiğim dosyadaki kodları silip aşağıdaki kodları kopyalayın.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bak As Integer
    If Target.Column = 5 Then
        Application.EnableEvents = False
        If Not IsNumeric(Cells(Target.Row + 1, 4).Value) Then

            
            For Bak = 5 To 8
                If Cells(Target.Row, Bak).Value <> "" Then
                    Rows(Target.Row + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                    Cells(Target.Row + 1, 4).FormulaR1C1 = Cells(Target.Row, 4).FormulaR1C1
                    Exit For
                End If
            Next
        ElseIf IsEmpty(Target.Value) Then ' And Cells(Target.Row, Target.Column - 1).Value <> "" Then
                Rows(Target.Row).Delete
            End If
        Application.EnableEvents = True
    End If
End Sub

 

[xemdarx]

Satır ekleme oldu galiba. .Lakin silme işlemi yeni eklenen satırlarda olmuyor.

 

[Muzaffer Ali]

Şimdi oldu her halde.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 5 Then
        Application.EnableEvents = False
        If Not IsNumeric(Cells(Target.Row + 1, 4).Value) Then
            If Cells(Target.Row, 5).Value <> "" Then
                Rows(Target.Row + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Cells(Target.Row + 1, 4).FormulaR1C1 = Cells(Target.Row, 4).FormulaR1C1
            End If
        End If
        If IsEmpty(Target.Value) Then
                Rows(Target.Row).Delete
            End If
        Application.EnableEvents = True
    End If
End Sub

 

[xemdarx]

Elinize emeğinize sağlık. İstediğim gibi olmuş..Teşekkürler