Mettre sur la même ligne des lignes contenant des cellules identiques

Sub grouper()
Application.ScreenUpdating = False
Sheets("Feuille triée").[A2].Resize(Sheets("Feuille triée").UsedRange.Rows.Count, 15).Clear
Set src = Sheets("Feuille d'origine")
With Sheets("Feuille triée")
ligne = .Cells(Rows.Count, 1).End(xlUp).Row + 1
For Each c In src.Cells(2, 1).Resize(src.Cells(Rows.Count, 1).End(xlUp).Row - 1, 1)
    If c <> c.Offset(-1, 0) Then
        .Cells(ligne, 1).Resize(1, 5).Value = c.Resize(1, 5).Value
        trouve = True
        col = 0
    Else
        col = col + 5
        .Cells(ligne - 1, 1).Offset(0, col).Resize(1, 5).Value = c.Resize(1, 5).Value
    End If
    If trouve Then ligne = ligne + 1: trouve = False
Next c
End With
Application.ScreenUpdating = True
End Sub

Sub transpose()
Dim a, i As Long, e, maxCol As Long, y, n As Long
    Application.ScreenUpdating = False
    With Sheets(1).Range("a1").CurrentRegion.Resize(, 5)
        With .Offset(1).Resize(.Rows.Count - 1)
            a = .Value
        End With
        With CreateObject("Scripting.Dictionary")
            For i = 1 To UBound(a, 1)
                If Not .exists(a(i, 1)) Then .Item(a(i, 1)) = Empty
                If IsEmpty(.Item(a(i, 1))) Then
                    ReDim w(1 To 5)
                Else
                    w = .Item(a(i, 1))
                    ReDim Preserve w(1 To UBound(w) + 5)
                End If
                w(UBound(w) - 4) = a(i, 1)
                w(UBound(w) - 3) = a(i, 2)
                w(UBound(w) - 2) = a(i, 3)
                w(UBound(w) - 1) = a(i, 4)
                w(UBound(w)) = a(i, 5)
                .Item(a(i, 1)) = w
                maxCol = Application.Max(maxCol, UBound(w))
            Next
            For Each e In .keys
                w = .Item(e)
                ReDim Preserve w(1 To maxCol)
                .Item(e) = w
            Next
            y = .items: n = .Count
        End With
        With Sheets(2).Cells(1)
            .CurrentRegion.Clear
            Sheets(1).Range("A1:E1").Copy .Resize(, maxCol)
            .Offset(1).Resize(n, maxCol).Value = _
            Application.transpose(Application.transpose(y))
            With .CurrentRegion
                .Columns.AutoFit
                .BorderAround ColorIndex:=1, Weight:=xlThin
                .Borders(xlInsideVertical).Weight = xlThin
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .Font.Name = "calibri"
                .Font.Size = 10
                With .Rows(1)
                    .Interior.ColorIndex = 41
                    .Font.ColorIndex = 2
                    .Font.Size = 11
                    .RowHeight = 20
                    .BorderAround ColorIndex:=1, Weight:=xlThin
                End With
                For i = 1 To maxCol Step 5
                    .Cells(1, i).Resize(1, 5).BorderAround Weight:=xlMedium
                    .Cells(1, i).Resize(n + 1, 5).BorderAround Weight:=xlMedium
                Next i
                .Parent.Activate
            End With
        End With
    End With
    Application.ScreenUpdating = True
End Sub