Sub dupliquerLignes()
Dim tabloLignes()
Set liste = CreateObject("scripting.dictionary")
For lig = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Not liste.exists(Cells(lig, 1) & "µ" & Cells(lig, 12) & "µ" & Cells(lig, 15) & "µ" & Cells(lig, 16)) Then _
liste(Cells(lig, 1) & "µ" & Cells(lig, 12) & "µ" & Cells(lig, 15) & "µ" & Cells(lig, 16)) = lig
Next lig
ReDim tabloLignes(1 To liste.Count)
tabloLignes = liste.items
Application.ScreenUpdating = False
For x = UBound(tabloLignes) To 0 Step -1
Rows(tabloLignes(x)).Copy
Rows(tabloLignes(x) + 1).Insert shift:=xlDown
Cells(tabloLignes(x) + 1, 25) = 219032
Cells(tabloLignes(x) + 1, 26) = "UPS EXPRESS"
Next x
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub