Concaténer lignes sous condition

Option Explicit


Sub Regroupe()
Dim I As Integer
Dim J As Integer
Dim K As Integer
Dim Tablo()
Dim Lg As Integer
Dim Indice As Integer
[COLOR="Red"]Dim Cl As Integer[/COLOR]

  ReDim Tablo(1 To 21, 1 To 1)
  Lg = 2
  While Cells(Lg, 1) <> ""
    Indice = 0
    For I = 1 To UBound(Tablo, 2)                         ' vérif si la réf est déjà inscrite
      If Tablo(1, I) = Cells(Lg, 1) Then Indice = I
    Next I
    If Indice = 0 Then                                    ' La réf n'existe pas
      Indice = UBound(Tablo, 2)
      Tablo(1, Indice) = Cells(Lg, 1)
      ReDim Preserve Tablo(1 To 21, 1 To Indice + 1)
    End If
    
    If Cells(Lg, 2) <> "" Then                             ' Stocke la colonne B
      For K = 2 To 11
        If Tablo(K, Indice) = "" Then
          Tablo(K, Indice) = Cells(Lg, 2)
          Exit For
        End If
      Next K
    End If
    
    If Cells(Lg, 3) <> "" Then                             ' Stocke la colonne c
      For K = 12 To 21
        If Tablo(K, Indice) = "" Then
          Tablo(K, Indice) = Cells(Lg, 3)
          Exit For
        End If
      Next K
    End If
    
    Lg = Lg + 1
  Wend
  '
  ' Début de recopie du tableau
  '
 [COLOR="Red"] Lg = 1        ' Ligne 1
  Cl = 24       ' Colonne X (Mais en réalité on commencera toujours 1 colonne aprés)[/COLOR]
  For I = 1 To UBound(Tablo, 2) - 1
    For J = 1 To 21
      Cells(Lg, J [COLOR="Red"]+ Cl[/COLOR]) = Tablo(J, I)
    Next J
    Lg = Lg + 1
  Next I
End Sub