VBA Code for data organizing and inserting specific number of Blank rows between each date data

In a column I have dates and blank cells in between. I want specific number of blank cells to recur after each date. However presently I do not have equal number of blank cells (in my case six) after each date. I am looking for the VBA code to insert blank rows between two dates so that the number of blank cells equals after each date.

My data looks like this:

I tried the following code:

Sub InsertBlankRowsAfterDates()    Dim ws As Worksheet    Set ws = ActiveSheet    Dim rng As Range    Set rng = ws.Range("A1:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row) ' Adjust the column as needed    Dim requiredBlanks As Integer    requiredBlanks = 6 ' Set the required number of blank cells after each date    Dim i As Long    For i = rng.Rows.Count To 1 Step -1        If IsDate(rng.Cells(i, 1).Value) Then            Dim blankCount As Integer            blankCount = 0            Dim j As Integer            For j = 1 To requiredBlanks                If rng.Cells(i + j, 1).Value = "" Then                    blankCount = blankCount + 1                Else                    Exit For                End If            Next j            If blankCount < requiredBlanks Then                ws.Rows(i + 1 & ":" & i + (requiredBlanks - blankCount)).Insert Shift:=xlDown            End If        End If    Next iEnd Sub

However, after running the code I have the following result.

But I want the data to appear as below:

I am unable to figure out the problem in the code.