satırda dolu hücreleri sayarak, koşula göre değer yazmak

[Orion1]

Kodların son hali aşağıdadır.

Sub HT59_HAZIRLA()
Dim gecenay As Integer, i As Long, k As Byte, say As Integer
Dim sonsat As Long, sh As Worksheet
For Each sh In Worksheets
    If sh.Name <> "BORDRO" And sh.Name <> "FATURA" And _
        sh.Name <> "FATURA1" And sh.Name <> "bölüm kodu" Then
        sonsat = sh.Cells(Rows.Count, "B").End(xlUp).Row
        For i = 5 To sonsat
            say = sh.Cells(i, "AK").Value
            For k = 3 To 33
                If sh.Cells(i, k).Value <> "" And sh.Cells(i, k).Value >= 4 Then
                    say = say + 1
                ElseIf sh.Cells(i, k).Value = "" Then
                    If say >= 6 Then
                        sh.Cells(i, k).Value = "HT"
                    End If
                    say = 0
                End If
            Next k
        Next i
    End If
Next sh
MsgBox "Hafta tatili yazıldı.", vbOKOnly + vbInformation
End Sub

 

[cerit]

Merhaba Hocam,
Elinize sağlık,istediğim gibi olmuş.
Selamlar.

 

[Orion1]

Merhaba Hocam,
Elinize sağlık,istediğim gibi olmuş.
Selamlar.

Rica ederim.
İyi çalışmalar.