Dolu satıra göre formülü aşağıya doğru arttırma

[MKURU]

Arkadaşlar herkese iyi çalışmalar.
Ekli dosyada ayrıntılı bir şekilde anlattığım gibi bir çalışma sayfasında B4:B aralığına veri girdikçe A4 hücresinde yazan

Kod: Tümünü seç

=EĞER(B4=0;0;SATIR()-3)

formülünün en son dolu satıra kadar aşağıya doğru yazılmasını istiyorum. Bu işlem için elimde bir kod var ama küçük bir düzenlemeye ihtiyacım var.

[hassan26]

Selam dosyanız ektedir.
Formülü her seferinde otomatik yazdırma yerine önceden istediğiniz kadar kodu aşağı çekin siz yazdıkça satır numarası verilsin.

[islakates]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ACell As Range
Dim LastRow As Long
Dim RowCounter As Long

If Not Intersect(Target, Me.Range("B4:B" & Me.Rows.Count)) Is Nothing Then
Application.EnableEvents = False

LastRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row

For Each ACell In Me.Range("A4:A" & LastRow + 4)
If ACell.Value = "" Then
ACell.Value = RowCounter + 1
Exit For
End If
RowCounter = RowCounter + 1
Next ACell

Application.EnableEvents = True
End If
End Sub

Hangi sayfada çalışıyorsanız o sayfanın kod kısmına ekleyin. Modül veya form kullanmaya gerek yok. Bir buton ile kontrol etmek isterseniz belirlediğiniz butona makro olarak ekleyin. umarım sorununuz çözülmüştür.