Tarih yaz makrosunda ayın 14. gününe kadar yazdırmak istiyorum

[kelkitli]

Değerli Dostlar Selamlar,
Ekteki Dosyada Ayın 1. gününden son gününe kadar tarihi yazdırıyorum. Bir sonraki ayın 1. gününde 14. gününe kadar daha yazdırmam gerekiyor ancak ayın sonuna kadar yazıyor. Makroda nasıl bir değişiklik yapmam gerekir.

Sub tarihyaz()
Dim j As Date
Set S1 = Sayfa1
S1.Range("E1:AI1").ClearContents
j = Sayfa1.ComboBox1.Value
Ay = Month(j)
j = DateSerial(Year(j), Month(j), 1)
i = 4
k = 6
Do While Month(j) = Ay
S1.Cells(i, "A") = j
S1.Cells(1, k) = j
i = i + 1
j = j + 1
k = k + 1
Loop
Set S1 = Nothing
End Sub
Sub tarihyaz1()
Dim j As Date
Set S1 = Sayfa1
S1.Range("AJ1:AV1").ClearContents
j = DateSerial(Year(S1.ComboBox1), Month(S1.ComboBox1) + 1, Day(S1.ComboBox1))
Ay = Month(j)
j = DateSerial(Year(j), Month(j), 1)
i = 4
k = 37
Do While Month(j) = Ay
S1.Cells(i, "A") = j
S1.Cells(1, k) = j
i = i + 1
j = j + 1
k = k + 1
Loop
Set S1 = Nothing
End Sub

 

[Levent Menteşoğlu]

tarihyaz1 prosedüründeki döngüyü aşağıdaki gibi değiştirin.

Do While Month(j) = Ay
    S1.Cells(i, "A") = j
If Day(j) < 15 Then S1.Cells(1, k) = j
    i = i + 1
    j = j + 1
    k = k + 1
Loop

 

[kelkitli]

Sayın Levent Hocam,
Teşekkürlerimi iletiyorum. Güzel oldu Sağolun, Varlun.