Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cellsarr As Variant, i As Integer
cellsarr = Array("E3", "F3", "G3", "H3", "I3") ' İzlenen hücreleri belirle
For i = LBound(cellsarr) To UBound(cellsarr)
Dim CurrentCell As Range
Set CurrentCell = Me.Range(cellsarr(i))
' Hücreye değer girildiyse ve değeri boş değilse satır ekle ve değeri yaz, değer silindi ise satırı sil
If Not Intersect(Target, CurrentCell) Is Nothing Then
Application.EnableEvents = False
If CurrentCell.Value <> "" Then
Me.Rows(i + 8 & ":" & i + 8).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Me.Cells(i + 8, 2).Value = CurrentCell.Value
Else
Me.Rows(i + 8).Delete Shift:=xlUp
End If
Application.EnableEvents = True
End If
Next i
End Sub