Fusion de cellules correspondant à des valeurs distinctes

Bonjour,

Ci joint deux fichiers que je vous propose pour mieux comprendre ma problématique. Le tableau initial est le tableau que j'ai au départ et le tableau final est celui que j'aimerais obtenir en obtenant votre aide.

Pour chaque cellule à valeur redondante d'une colonne de mon tableau donnée, je voudrais avoir une colonne avec ces valeurs distinctes et que toutes les autres cellules des autres colonnes qui correspondaient à cette valeur fusionne pour que je puisse faire des statistiques du genre , pour cette valeur distincte, il existe 2 valeur dans la colonne B, ces deux valeurs se retrouvent dans une même cellule, 3 valeur dans la colonne C qui se retrouvent dans une même cellule et ainsi de suite et cela me fera désormais une ligne dans mon tableau et on passe à la valeur distincte suivante.

Vous remerciant de votre aide, je reste à votre écoute.

Bonjour,

Sub Fablene()
    Dim d As Object, n%, i%, ln%
    Set d = CreateObject("Scripting.Dictionary")
    Application.ScreenUpdating = False
    With ActiveSheet
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        With .Range("A1:C" & n)
            .VerticalAlignment = xlCenter
            .WrapText = True
        End With
        For i = 1 To n
            If d.exists(.Cells(i, 1).Value) Then
                ln = CInt(d(.Cells(i, 1).Value))
                .Cells(ln, 2) = .Cells(ln, 2) & Chr(10) & .Cells(i, 2)
                .Cells(ln, 3) = .Cells(ln, 3) & Chr(10) & .Cells(i, 3)
                .Cells(i, 1).ClearContents
            Else
                d(.Cells(i, 1).Value) = i
            End If
        Next i
        .Range("A1:A" & n).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End With
End Sub

Cordialement.