Hi madball87

See if this code does as you require 
Option Explicit
Sub insert_rows()
    Dim rng As Range
    Dim LR As Long
    Dim i As Long
    Dim x As Long
    Application.ScreenUpdating = False
    LR = Range("A" & Rows.Count).End(xlUp).Row
    Set rng = Range("A4:A" & LR)
    With rng
        For i = LR To 2 Step -1
            x = DateDiff("d", rng(i).Offset(-1, 0).Value, rng(i).Value)
            If x > 1 Then
                rng(i).Resize(x - 1, 1).EntireRow.Insert
                Range(rng(i).Offset(-1, 0).Address).AutoFill Destination:=Range(rng(i).Offset(-1, 0).Address & ":" & rng(i).Offset(x - 1, 0).Address), Type:=xlFillDefault
                Range(rng(i).Offset(-1, 1).Address).Copy Destination:=Range(rng(i).Offset(0, 1).Address & ":" & rng(i).Offset(x - 2, 1).Address)
            End If
        Next i
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub