Makro ile şartlı veri yazdırma

[ytemtek07]

Merhaba, dener misiniz hocam;

Sub UcAyArdisikSifirSonrasiOdeme()
    Dim ws As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim i As Long, j As Long
    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    ws.Cells(1, lastCol + 1).Value = "Ödeme Başlangıç Tarihi"

    For i = 2 To lastRow
        Dim found As Boolean
        found = False
        For j = lastCol To 5 Step -1
            If ws.Cells(i, j).Value = 0 And ws.Cells(i, j - 1).Value = 0 And ws.Cells(i, j - 2).Value = 0 Then
                Dim k As Long
                k = j + 1
                If k <= lastCol And ws.Cells(i, k).Value > 0 Then
                    ws.Cells(i, lastCol + 1).Value = ws.Cells(1, k).Value
                    found = True
                    Exit For
                End If
            End If
        Next j
       
        If Not found Then
            ws.Cells(i, lastCol + 1).Value = ""
        End If
    Next i
    MsgBox "İşlem tamamlandı.", vbInformation
End Sub

Cok tesekkurler tam istediğim gibi emeğinize sağlık.birsey daha öğrenmek için soruyorum a sütununda personel adı yazıyor "u " stunlarina kadar personel bilgilerini ekledigimde , yani makro kontrolü v stunundan sonrakilere bakacak bu makroda neyi değiştirmelisin?

 

[ytemtek07]

Harika valla çok fena bir iş yükünden kurtardınız beni