Leerzeile nach Monatsletzten

Public Sub Kalender()
Dim WkSh_K   As Worksheet
Dim WkSh_F   As Worksheet
Dim aktJahr  As Integer
Dim dDatum   As Date
Dim lZeile   As Long
Dim lFtage   As Long
Application.ScreenUpdating = False
Set WkSh_K = Worksheets("Stundennachweis")   ' Kalenderblatt
Set WkSh_F = Worksheets("Tabelle2")   ' Feiertagsblatt
If IsNumeric(WkSh_K.Range("A1").Value) And _
Len(WkSh_K.Range("A1").Value) = 4 Then
aktJahr = CInt(WkSh_K.Range("A1").Value)
dDatum = "01.01." & aktJahr
Else
MsgBox "In Zelle A1 steht keine gültige Jahreszahl - Abbruch.", _
48, "   Hinweis für " & Application.UserName
Exit Sub
End If
lZeile = 5
Do
WkSh_K.Range("A" & lZeile).NumberFormat = "dddd"
WkSh_K.Range("A" & lZeile).Value = dDatum
For lFtage = 1 To WkSh_F.Range("A65536").End(xlUp).Row
If dDatum = CDate(WkSh_F.Range("A" & lFtage).Value) Then
WkSh_K.Range("A" & lZeile).Interior.ColorIndex = 3
Exit For
End If
Next lFtage
dDatum = dDatum + 1
lZeile = lZeile + 1
Loop Until Year(dDatum) > aktJahr
End Sub