Sub Deplacer()
Application.ScreenUpdating = False
For Each cellule In Range("D2:D" & Range("D65535").End(xlUp).Row)
If Left(cellule, 2) = "FR" Then
Range(Cells(cellule.Row, 4), Cells(cellule.Row, 5)).Copy Destination:=Cells(cellule.Row, 5)
Cells(cellule.Row, 4) = ""
End If
Next cellule
Application.ScreenUpdating = True
End Sub