Sub cartman() ligne_deb = 1 col_deb = 2 For i = ligne_deb + 1 To Range("B65536").End(xlUp).Row If Cells(i, col_deb) = Cells(i - 1, col_deb) And _ Cells(i, col_deb + 1) = Cells(i - 1, col_deb + 1) And _ Cells(i, col_deb + 2) = Cells(i - 1, col_deb + 2) And _ Cells(i, col_deb + 2) "" Then Cells(i - 1, Range("IV" & i - 1).End(xlToLeft).Column + 1) = Cells(i, col_deb + 3) Rows(i).Delete Shift:=xlUp i = i - 1 End If Next i End Sub