Need to fill blanks in one column with ascending dates of the month - excel

Question

I have a workbook that creates daily reports in separate worksheets and at the end of the month I click a button that creates a monthly summary sheet from all of the individual daily sheets. The code that creates the monthly summary sheet has some lines that insert a blank row every 10 rows because the next day's data starts every 10 rows.
What I'm trying to do now is find the code that will insert the date into column A of the newly created blank rows. So column A in the first newly created blank line would contain 1/1/2018,The 2nd newly created blank row would have 1/2/2018 and so on.
Here is my current code, please let me know if you have any ideas for what to add to it to insert the dates in the newly created blank row. Another possible solution that I don't know how to implement would be copying the title of each worksheet to every 10th row since every worksheet is simply titled the date.
Sub endofmonth()
'This sub should be run at the end of the month and will generate a monthly summary sheet
Dim wrk As Workbook
Dim sht As Worksheet
Dim trg As Worksheet
Dim rng As Range
Dim colCount As Integer
Set wrk = ActiveWorkbook
For Each sht In wrk.Worksheets
If sht.Name = "Month End" Then
MsgBox "There is a worksheet called as 'Month End'." & vbCrLf & _
"Please remove or rename this worksheet since 'Month End' would be" & _
"the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error"
Exit Sub
End If
Next sht
Application.ScreenUpdating = False
Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
trg.Name = "Month End"
Set sht = wrk.Worksheets(1)
colCount = sht.Cells(1, 255).End(xlToLeft).Column
With trg.Cells(1, 1).Resize(1, colCount)
.Value = sht.Cells(1, 1).Resize(1, colCount).Value
.Font.Bold = True
End With
For Each sht In wrk.Worksheets
If sht.Index = wrk.Worksheets.Count Then
Exit For
End If
Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))
trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
Next sht
trg.Columns.AutoFit
'This part of the code formats the Monthly Summary sheet correctly
With ThisWorkbook.Sheets("Month End")
.Columns(1).Resize(.Rows.Count - 1, 1).Offset(1, 0).NumberFormat = "HH:MM AM/PM"
.Columns(4).Resize(.Rows.Count - 1, 1).Offset(1, 0).NumberFormat = "00"
.Columns(10).Resize(.Rows.Count - 1, 1).Offset(1, 0).NumberFormat = "00.00"
.Columns(17).Resize(.Rows.Count - 1, 1).Offset(1, 0).NumberFormat = "0.00%"
.Columns(18).Resize(.Rows.Count - 1, 1).Offset(1, 0).NumberFormat = "0.00%"
.Columns(19).Resize(.Rows.Count - 1, 1).Offset(1, 0).NumberFormat = "0.00%"
'This part of the code inserts a break at the end of every day on the monthly summary sheet
Dim rw As Long
Dim lr As Long
Dim cnt As Long
lr = Range("A" & Rows.Count).End(xlUp).Row
rw = 2
cnt = 1
Do
If cnt = 10 Then
Rows(rw).Insert Shift:=xlDown
cnt = 1
lr = Range("A" & Rows.Count).End(xlUp).Row
Else
cnt = cnt + 1
End If
rw = rw + 1
Loop While rw <> lr
End With
Application.ScreenUpdating = True
End Sub
Any help would be greatly appreciated!

Answer 1

Based on comment:
It would always be pressed on the last day of the month. So I would
have pressed it on the 30th of march since that's the last work day of
march.
You just need to add a variable keeping track of the day, and then use that variable inside the If cnt = 10 Then block.
Add this variable:
Dim DayIndex as Date: DayIndex = CDate(Evaluate("DATE(YEAR(TODAY()),MONTH(TODAY()),1)"))
And then:
If cnt = 10 Then
Rows(rw).Insert Shift:=xlDown
Cells(rw, "A").Value = DayIndex
Cells(rw, "A").NumberFormat = "d/m/yyyy"
DayIndex = DayIndex + 1
cnt = 1
lr = Range("A" & Rows.Count).End(xlUp).Row
Else