romanholi,

Não sei como é seu arquivo e estou trabalhando com suposições. Aqui, não ocorreu nenhum problema e executou normalmente até a última linha (tela anexa).

A execução eu fiz com o código abaixo:

Sub teste()
    UltimaLinha = Sheets("Plan1").Cells(Cells.Rows.Count, 2).End(xlUp).Row
    
    For M = 2 To UltimaLinha
         If Range("B" & M) <> Range("B" & M - 1) Then
             Rows(M & ":" & M).Select
             Selection.Copy
             Selection.Insert Shift:=xlDown
            
             Range("E" & M) = Range("B" & M)
             Range("F" & M) = Range("B" & M)
             Range("G" & M) = "UN"
             Range("H" & M) = "1"
             Range("I" & M) = "1"
             Range("J" & M) = "1"
          End If
    Next
End Sub

Wagner, obrigado pelo retorno.
Veja meu anexo.
O loop só vai até a linha 34, e como são inseridas novas linhas ele não chega até o último código que precisa ser duplicado.

Obrigado

Aproveitando o código do colega wagner, veja se isso resolve:

Sub teste()
Dim M As Integer
  
    For M = 2 To UsedRange.Rows.Count
         
         If Range("B" & M) <> Range("B" & M - 1) Then
             Rows(M & ":" & M).Select
             Selection.Copy
             Selection.Insert Shift:=xlDown
            
             Range("E" & M) = Range("B" & M)
             Range("F" & M) = Range("B" & M)
             Range("G" & M) = "UN"
             Range("H" & M) = "1"
             Range("I" & M) = "1"
             Range("J" & M) = "1"
          End If
         
    Next
    
    
End Sub

Boa Tarde Arruda.

Quase funcionou, ele está duplicando a última linha... não deveria.

Vi que ele faz o loop 182 vezes... como o UsedRange.Rows.Count chegou nesse número? Só tenho 33 linhas, antes de rodar o loop.

Entendi...

Bom, não testei mas... no caso de exclusões e inserções de linhas, geralmente se usa a contagem de baixo pra cima para evitar esse tipo de problema. Veja se assim resolve.

Sub teste()

Dim UltimaLinhas As Integer
Dim M            As Integer

    UltimaLinha = ActiveSheet.Cells(Cells.Rows.Count, 2).End(xlUp).Row
    
    For M = UltimaLinha To 2 Step -1
         If Range("B" & M) <> Range("B" & M - 1) Then
             Rows(M & ":" & M).Select
             Selection.Copy
             Selection.Insert Shift:=xlDown
            
             Range("E" & M) = Range("B" & M)
             Range("F" & M) = Range("B" & M)
             Range("G" & M) = "UN"
             Range("H" & M) = "1"
             Range("I" & M) = "1"
             Range("J" & M) = "1"
          End If
    Next
    
    
End Sub

Exatamente isso meu amigo!
De baixo para cima! Aprendi! Step-1

Muitíssimo Obrigado aos Amigos