Sub DupliqueLignes3()
Dim Lmax As Long, L As Long
With Feuil1
Lmax = .Cells(.Rows.Count, 1).End(xlUp).Row
For L = Lmax To 1 Step -1
If L = 1 Then Exit For
If .Cells(L, 2) <> .Cells(L - 1, 2) Then
With .Rows(L)
.Copy
.Offset(1, 0).Resize(3).Insert Shift:=xlDown
End With
End If
Next L
End With
Application.CutCopyMode = False
End Sub