You could use a Do/While loop as follows:-
Dim Rw As Long
Dim Rng As Range
Set Rng = Sheet1.Range("A2") '---->Headings in Row1, data starts in Row2. Else, Rng = Sheet1.Range("A1")
Rw = Rng.Row
If Sheet1.Cells(Rw + 1, 4) <> Sheet1.Cells(Rw, 4) Then
Sheet1.Cells(Rw + 1, 4).EntireRow.Insert
Rw = Rw + 2
Rw = Rw + 1
Loop While Not Sheet1.Cells(Rw, 4) = vbNullString
I'm assuming that your data starts in Row2 with headings in Row1.
The code works based on separating the data on the text (names) in Column D.
As I don't know what your sheet name is, I've used the sheet code (Sheet1) to fully qualify your "working sheet" in the code above.
I hope that this helps.