Probleme de tri et de regroupement

Option Explicit
Private Const WS_Source As String = "Feuil1" 'A Adapter
Private Const WS_Cible As String = "Feuil2" 'A Adapter
 
Sub Rebuilding_Group()
Dim TabDataSource As Variant
Dim ColTimeRef As Collection
Dim Ref As Variant
Dim Container As Variant
Dim L As Long, i As Integer, C As Byte
i = 1
C = 2
 
With Sheets(WS_Source)
    .Activate
    .UsedRange.Sort Key1:=Range("A1"), Order1:=xlAscending, _
                    Key2:=Range("B1"), Order2:=xlAscending
 
    TabDataSource = .Range(.Range("A1"), .Range("C65536").End(xlUp))
End With
Set ColTimeRef = New Collection
For L = 1 To UBound(TabDataSource, 1)
    On Error Resume Next
            ColTimeRef.Add CStr(Format(TabDataSource(L, 1), "HH:MM:SS")) & Chr(35) & CStr(TabDataSource(L, 2)), CStr(Format(TabDataSource(L, 1), "HH:MM:SS")) & Chr(35) & CStr(TabDataSource(L, 2))
    On Error GoTo 0
Next
 
    For Each Ref In ColTimeRef
        Container = Split(Ref, Chr(35))
            For L = 1 To UBound(TabDataSource, 1)
                If CStr(Format(TabDataSource(L, 1), "HH:MM:SS")) = Container(0) Then
                        If TabDataSource(L, 2) = Container(1) Then
                             With Sheets(WS_Cible)
                                .Cells(i, 1) = Format(TabDataSource(L, 1), "HH:MM:SS")
                                .Cells(i, 2) = TabDataSource(L, 2)
                                    C = C + 1
                                .Cells(i, C) = TabDataSource(L, 3)
                              End With
                        Else
                            C = 2
                        End If
                End If
            Next
    i = i + 1
    Next
 
End Sub