¿Insertar fila varios duplicado en excel?

Te anexo la macro

Sub Insertar_Fila()
'Por Dante Amor
'   Insertar fila
'
    u = Range("A" & Rows.Count).End(xlUp).Row
    ant = Range("A" & u)
    For i = u To 1 Step -1
        If ant <> Cells(i, "A") Then
            Rows(i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
        ant = Cells(i, "A")
    Next
End Sub

.

.

Rafael Vera,

Adjunto un código más como opción para el desarrollo de tu consulta.

Sub InsertarFilas()
'Asumiendo que los datos de la columna A inicia en la celda A1.
'Y la columna A esta ordenando.
x = 0
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
    j = i + x
    If Cells(j, 1) <> Cells(j + 1, 1) Then
        Rows(j + 1 & ":" & j + 1).Insert Shift:=xlDown
        x = x + 1
    End If
Next i
End Sub

Ander GS

Te paso esta macro después de cada serie de repetidos inserta una fila, solo modifica la instrucción range("a2") a tus necesidades.

Sub insertar_fila()
Dim datos As Range, repetidos As Range
Dim unicos As New Collection
Dim f As Integer, j As Integer, fila As Integer, cuenta As Integer
Set datos = Range("a2").CurrentRegion
With datos
    f = .Rows.Count
    For I = 1 To f
        NOMBRE = .Cells(I, 1)
        On Error Resume Next
            unicos.Add NOMBRE, CStr(NOMBRE)
        On Error GoTo 0
    Next I
    For j = 1 To unicos.Count
        NOMBRE = unicos.Item(j)
        fila = WorksheetFunction.Match(NOMBRE, .Columns(1), 0)
        cuenta = WorksheetFunction.CountIf(.Columns(1), NOMBRE)
        Set repetidos = .Rows(fila).Resize(cuenta)
        repetidos.Rows(cuenta + 1).EntireRow.Insert
    Next j
End With
End Sub