Aktar ile yıl ve ay yazdırma

[sirkülasyon]

Sub Aktar()

    Dim Sb As Worksheet, Sa As Worksheet, son_b As Long, son_a As Long

    Set Sb = Sheets("Bordro")
    Set Sa = Sheets("ARŞİV")

    son_b = WorksheetFunction.Count(Sb.Range("B11:B" & Rows.Count))
    son_a = Sa.Cells(Rows.Count, "B").End(xlUp).Row + 1
    If Sa.Range("C4") = "" Then son_a = 4

    Application.ScreenUpdating = False

    Sb.Range("B11").Resize(son_b, 33).Copy
    Sa.Cells(son_a, "B").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Sa.Cells(son_a, "AH").Resize(son_b, 1) = "2018-6" 'yıl ay ilavesi

    son_a = Sa.Cells(Rows.Count, "B").End(xlUp).Row
    Sa.Range("B4:AH" & son_a).Sort Sa.Range("C3"), xlAscending 'AG yerine AH yazıldı.

    Application.CutCopyMode = False
    Application.ScreenUpdating = True

End Sub

Kod Arşiv sayfasına Alfabetik olarak aktarma yapıyor. Kod sıkıntısız çalışıyor. Sadece
Sa.Cells(son_a, "AH").Resize(son_b, 1) = "2018-6" 'yıl ay ilavesi
kod satırında kısmı her aktarma da 2018-6 yazıyor.
Aktarma hangi ayda ise o yıl ve ayı yazması için kodu düzeltmede yardımcı olabilir misiniz?
Örnek :
Mayıs Ayında ise 2018 - 5
Haziran Ayında ise 2018 - 6
Temmuz Ayında ise 2018-7
Yıl devir etti ise ve Ocak ayı ise 2019-1
gibi
Teşekkür Ederim. Saygılarımla

 

[Muzaffer Ali]

Günün tarihini mi yazmak istiyorsunuz?
Eğer öyle ise

"2018-6"

silin yerine aşağıdaki kodu yazın.

year(now) & " - " & month(now)

 

[sirkülasyon]

dalgalikur Allah Razı Olsun. Çok Teşekkür Ederim