Groupe lignes de la mme couleur sur excel

Option Explicit   

Private Sub CommandButton1_Click()   

Const nblimax = 100   ' 100 couleurs de lignes maxi   

Dim nbli As Long   
Dim nbco As Long   

Dim li As Long, co As Long, lico As Long, numCoul As Long, nbCoul As Long   
Dim tabCoul(nblimax) As Long   
Dim coul As Long   
Dim coulId As Boolean   

' recuperer les nombres de lignes et de colonnes de tab   
  nbli = Range("Tab").Rows.Count   
  nbco = Range("Tab").Columns.Count   

' recuperer le tableau des couleurs   
  With Range("Tab")   
    nbCoul = 1   
    coul = .Cells(1, 1).Interior.Color   
    tabCoul(nbCoul) = coul   
    For li = 2 To nbli   
      coul = .Cells(li, 1).Interior.Color   
      coulId = False   
      For numCoul = 1 To nbCoul   
        coulId = coulId Or (coul = tabCoul(numCoul))   
      Next numCoul   
      If Not coulId Then   
        nbCoul = nbCoul + 1   
        tabCoul(nbCoul) = coul   
      End If   
    Next li   
  End With   
     
' recopier en regroupant les lignes de même couleur   
  Worksheets("Copie").Cells.ClearContents   
  With Range("Tab")   
    li = 0   
    lico = 0   
    For numCoul = 1 To nbCoul   
      For li = 1 To nbli   
        If .Cells(li, 1).Interior.Color = tabCoul(numCoul) Then   
          lico = lico + 1   
          For co = 1 To nbco   
            Worksheets("Copie").Cells(lico, co).Value = .Cells(li, co).Value   
            Worksheets("Copie").Cells(lico, co).Interior.Color = .Cells(li, co).Interior.Color   
          Next co   
        End If   
      Next li   
    Next numCoul   
  End With   
     
End Sub