Sub Macro()
Dim tablo, rest(), i&, n&
With [A1].CurrentRegion
.Sort .Columns(1), xlAscending, .Columns(2), , xlDescending, Header:=xlYes 'tri sur 2 colonnes
tablo = .Resize(1 + 2 * Int((.Rows.Count - 1) / 2), 3) 'matrice, plus rapide
End With
ReDim resu(1 To UBound(tablo), 1 To 3)
For i = 2 To UBound(tablo) - 1 Step 2 '1 ligne sur 2
If tablo(i + 1, 1) <> tablo(i, 1) Then _
Range("A" & i).Select: MsgBox "Numéros différents en lignes " & i & " et " & i + 1 & "!": Exit Sub
n = n + 1
resu(n, 1) = tablo(i, 1)
resu(n, 2) = tablo(i, 3)
resu(n, 3) = tablo(i + 1, 3)
Next
'---restitution---
With [E2]
If n Then .Resize(n, 3) = resu
.Offset(n).Resize(Rows.Count - n - .Row + 1, 3).ClearContents 'RAZ en dessous
End With
End Sub