Bir alt satırda yazan YIL ve AY diliminin üst satırına bir sonraki YIL ve AY dilimini yazdırma

[ptcsite]

Option Explicit
Public Sub Satir_Ekle()
Dim son, i As Integer
Dim ekle As Integer
ReDim aylar(1 To 12) As String

aylar(1) = "Ocak"
aylar(2) = "Şubat"
aylar(3) = "Mart"
aylar(4) = "Nisan"
aylar(5) = "Mayıs"
aylar(6) = "Haziran"
aylar(7) = "Temmuz"
aylar(8) = "Ağustos"
aylar(9) = "Eylül"
aylar(10) = "Ekim"
aylar(11) = "Kasım"
aylar(12) = "Aralık"

If Range("A4") > 0 Then
    Rows(4).Insert Shift:=xlDown
    Rows(4).RowHeight = 15
            For i = 1 To 12
                If Range("A5").Value = CDate(Format(Now, "yyyy")) And Range("B5").Value = Format(Now, "mmmm") Then
                    Exit Sub
                ElseIf Range("A5").Value = CDate(Format(Now, "yyyy")) And Range("B5").Value = aylar(i) Then
                    Range("A4") = Range("A5").Value
                        If aylar(i) = "Aralık" Then
                            Range("B4").Value = aylar(1)
                        Else
                            Range("B4").Value = aylar(i + 1)
                        End If
                Range("B4").HorizontalAlignment = xlLeft
                ElseIf CDate(Format(Now, "yyyy")) - Range("A5").Value >= 1 And Range("B5").Value = aylar(i) Then
                    If aylar(i) = "Aralık" Then
                        Range("A4") = Range("A5").Value + 1
                        Range("B4").Value = aylar(1)
                    Else
                        Range("A4") = Range("A5").Value
                        Range("B4").Value = aylar(i + 1)
                    End If
                Range("B4").HorizontalAlignment = xlLeft
                End If
            Next
Else
    Rows(4).EntireRow.Delete
End If

End Sub

Satı kutucuklara Yıl ve Ay yazarak çalıştırdığımızda; sarı sütunun bir üstüne satır oluşturup o satıra sonraki tarihi yazdırıyoruz. Bu C sütunundan başlayarak diğer sütunlara doğru veri girişlerinde kayıtların karışmasını önleyebilir... İlgili dosyayı da ekliyorum. Umarım çalışmalarınızda kolaylık sağlar

 

[ptcsite]

Dosya ekleyeme yeri kaldırılmış yanılmıyorsam dosya ekleyemedim.

 

[Korhan Ayhan]

Sorunuzu hatalı bölüme açtığınız için dosya ekleyemiyor olabilirsiniz. Ben konunuzu ilgili bölüme taşıyorum.

Tekrar dosya eklemeyi deneyebilirsiniz.

 

[Korhan Ayhan]

Ben soru sorduğunuzu sanmıştım. Siz örnek dosya paylaşmışsınız...

Dosyanızı denediğimde 2025 Ocak ayına kadar ekleme yapıyor..