Adding data with a macro

[shahji]

Hello,

I am trying to write a macro to add a few headings. I have the following macro.

Sub DOPaste()

Dim i As Integer

y =11
z = y

Do While Sheets("Investments").Range("A" & y).Value <> ""

i = 1

Sheets("Investments").Cells(z + 1, "D") = "Interim for year"
Sheets("Investments").Cells(z + 3, "D") = "2nd lnterim for year"
Sheets("Investments").Cells(z + 6, "D") = "3rd lnterim for year"
Sheets("Investments").Cells(z + 9, "D") = "Final for year"

i = i + 1
Loop

End Sub

Basically what i want the macro to do is paste the above four headings if there is a value in column A. Lets say Column A has a value in row 11 then the macro will past the headings in the column D at the specified rows.
let suppose if column A has two or three values in Row 11, 25, 39 and so on then the macro should do the same procedure and add the headings in column D starting from row 11 and then 25 and then 39.

my macro do it for once and stops there. i want it to carryon and past the same headings at intervals given above if there is a value in Column A.

thanks for help,

Shah