Sub TrierColonneA()
Dim i&, n&
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next 'si aucune SpecialCell
With [A1].CurrentRegion
.Cells.UnMerge 'défusionne toutes les cellules
.Columns(1).SpecialCells(xlCellTypeBlanks) = "=R[-1]C"
.Columns(1) = .Columns(1).Value 'supprime les formules
.Sort .Columns(1), xlAscending, Header:=xlYes 'tri
For i = 2 To .Rows.Count
If .Cells(i, 1) <> "" Then
n = Application.CountIf(.Columns(1), .Cells(i, 1))
.Cells(i, 1).Resize(n).Merge 'refusionne en colonne A
.Cells(i, 2).Resize(n).Merge 'refusionne en colonne B
.Cells(i, 6).Resize(n).Merge 'refusionne en colonne F
End If
Next
End With
End Sub