Sub foo()
    Dim lRow As Long, lLastRow As Long
    Dim rngToInsert As Range
    
    lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For lRow = 2 To lLastRow
        With Cells(lRow, 1)
            If .Value2 <> .Offset(1).Value2 Then
                If rngToInsert Is Nothing Then
                    Set rngToInsert = .Offset(1)
                Else
                    Set rngToInsert = Application.Union(rngToInsert, .Offset(1, lRow Mod 2))
                End If
            End If
        End With
    Next lRow
    
    If Not rngToInsert Is Nothing Then
        Application.ScreenUpdating = False
        rngToInsert.EntireRow.Insert shift:=xlShiftDown
        Application.ScreenUpdating = True
    End If
    
End Sub