Sub Accoler()
Dim derlig, t, v, k&, i&, ref, deb, fin
   With Sheets("Feuil1")
      If .FilterMode Then .ShowAllData
      derlig = .Cells(.Rows.Count, "a").End(xlUp).Row
      .Range("a2:c" & derlig + 1).Sort key1:=.Range("a2"), order1:=xlAscending, _
         key2:=.Range("b2"), order2:=xlAscending, key3:=.Range("c2"), order3:=xlAscending, _
         Header:=xlYes
      t = .Range("a2:c" & derlig + 1): v = .Range("a2:c" & derlig + 1): k = 1
      ref = t(2, 1): deb = t(2, 2): fin = t(2, 3)
      For i = 3 To UBound(t)
         If t(i, 1) <> ref Or t(i, 2) <> (fin + 1) Then
            k = k + 1
            v(k, 1) = ref: v(k, 2) = deb: v(k, 3) = fin
            ref = t(i, 1): deb = t(i, 2): fin = t(i, 3)
         Else
            fin = t(i, 3)
         End If
      Next i
      Application.ScreenUpdating = False
      .Range("f1:h" & Rows.Count).Clear
      .Range("f2").Resize(k, 3) = v
      .Range("f2").Resize(.Cells(.Rows.Count, "f").End(xlUp).Row - 1, 3).Borders.LineStyle = xlContinuous
      .Range("f2").Resize(, 3).Interior.Color = RGB(200, 200, 200)
      .Range("f2").Resize(, 3).Font.Bold = True
      .Range("f2").Resize(, 3).HorizontalAlignment = xlCenter
      .Range("f2").Resize(, 3).EntireColumn.AutoFit
   End With
End Sub