gestion de doublon

Option Explicit
Sub test()
Dim a, i As Long, w(), n As Long, t As Long
    With Sheets("Feuil1").Range("a1").CurrentRegion
        a = .Value
        n = 1: t = 2: a(1, 2) = "FONCTION 1"
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 2 To UBound(a, 1)
                If Not .exists(a(i, 1)) Then
                    n = n + 1
                    a(n, 1) = a(i, 1)
                    a(n, 2) = a(i, 2)
                    .Item(a(i, 1)) = VBA.Array(n, 2)
                Else
                    w = .Item(a(i, 1))
                    w(1) = w(1) + 1
                    .Item(a(i, 1)) = w
                    If UBound(a, 2) < w(1) Then
                        ReDim Preserve a(1 To UBound(a, 1), 1 To w(1))
                    End If
                    a(w(0), w(1)) = a(i, 2)
                    t = Application.Max(t, w(1))
                End If
            Next
        End With
        'Restitution à côté du tableau initial
        With .Offset(, .Columns.Count + 1)
            .CurrentRegion.Clear
            .Resize(n, t).Value = a
            With .CurrentRegion
                If .Columns.Count > 2 Then
                    .Cells(1, 2).AutoFill _
                            Destination:=.Cells(1, 2).Resize(, .Columns.Count - 1)
                End If
                .BorderAround Weight:=xlThin
                .Borders(xlInsideVertical).Weight = xlThin
                .Borders(xlInsideHorizontal).Weight = xlThin
                .VerticalAlignment = xlCenter
                With .Rows(1)
                    .Interior.ColorIndex = 36
                End With
                .Columns.AutoFit
            End With
        End With
    End With
End Sub