Sub Regrouper()
Dim tablo, resu(), i&, n&, j%
With Feuil1 'CodeName
    With .[A1].CurrentRegion.Resize(, 5)
        .Sort .Cells(1), xlAscending, .Cells(1, 3), , xlAscending, .Cells(1, 4), xlAscending, Header:=xlYes
        tablo = .Value2
    End With
    ReDim resu(1 To UBound(tablo), 1 To 6)
    For i = 2 To UBound(tablo)
        If tablo(i, 1) & tablo(i, 3) <> tablo(i - 1, 1) & tablo(i - 1, 3) Or tablo(i, 4) <> Val(tablo(i - 1, 4)) + 1 Then
            n = n + 1
            For j = 1 To 4: resu(n, j) = tablo(i, j): Next
        End If
        resu(n, 5) = tablo(i, 4)
        resu(n, 6) = Val(resu(n, 5)) - Val(resu(n, 4)) + 1
    Next
    '---restitution---
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .[G2] '1ère cellule de destination, à adapter
        If n Then .Resize(n, 6) = resu
        .Offset(n).Resize(Rows.Count - n - .Row + 1, 6).ClearContents 'RAZ en dessous
    End With
End With
End Sub