re,
un autre version à tester,
Sub Couper_coller2()
Dim n As Integer, i As Integer, plg As Range
On Error Resume Next
Set plg = Application.InputBox("Sélectionner les noms", Title:="SÉLECTION", Type:=8)
Set dest = Application.InputBox("Sélectionner la 1er cellule de destination", Title:="SÉLECTION", Type:=8)
If plg Is Nothing Or dest Is Nothing Then MsgBox "Vous n'avez pas fait les sélections": Exit Sub
n = dest.Row
For i = 1 To plg.Count Step 2
Cells(n, dest.Column) = plg(i)
Cells(n, dest.Column + 2) = plg(i + 1)
n = n + 4
Next
plg.ClearContents
End Sub