Sub InsereLinhasIguais()
 Dim nf As Long
  For nf = 2 To Cells(Rows.Count, 1).End(3).Row
   If Cells(nf, 1) > 1 Then
    Cells(nf, 1).EntireRow.Copy
    Cells(nf + 1, 1).Resize(Cells(nf, 1) - 1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=True
    nf = nf + Cells(nf, 1) - 1
   End If
  Next nf
End Sub

Obrigado amigo, desculpe a demora, funcionou bem!!!

Pessoal, boa tarde!

Aqui de volta nesse post depois de tanto tempo, o que preciso?
Esse código esta indo até a linha 175 e do nada, ele para, como faço para que continua e ler e acrescentar as linhas conforme o critério da coluna A?

Bom dia, @celri_33

Não é uma boa técnica de programação mudar o valor do contador em laços For/Next, ainda mais nesse seu caso em que as linhas vão crescendo e se deslocando pra baixo. Então chega uma hora em que o número de linhas já inseridas somadas às já existentes até aquele ponto atinge ou ultrapassa o valor inicial previsto para a última linha, que era estático.

O melhor nesses casos é vir inserindo as linhas de baixo pra cima. Teste com essa alteração:

Sub InsereLinhasIguais()
 Dim nf As Long
 Application.ScreenUpdating = False
   For nf = Cells(Rows.Count, 1).End(3).Row To 2 Step -1
     If Cells(nf, 1) > 1 Then
       Cells(nf, 1).EntireRow.Copy
       Cells(nf + 1, 1).Resize(Cells(nf, 1) - 1).EntireRow.Insert Shift:=xlShiftDown
     End If
   Next nf
 Application.ScreenUpdating = True
End Sub