Nom et vetement plus quantité a partir d'un tableau

Option Explicit 'oblige à déclarer toutes les variables


Sub Macro1()
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim ln As Range 'déclare la variable ln (Ligne du Nom)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim nb As Byte 'déclare la variable nb (NomBre)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)
Dim celi As Range 'déclare la variable celi (CEllule de la LIgne)
Dim i As Byte 'déclare la variable i (Incrément)


With Sheets("LISTE") 'prend en compte l'onglet "LISTE"
    dl = .Cells(Application.Rows.Count, 2).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 2 (=B)
    Set pl = .Range("B3:B" & dl) 'définit la plage pl
End With 'fin de la prise en compte de l'onglet "LISTE"
Application.ScreenUpdating = False 'masque les changements à l'écran
For Each cel In pl 'boucle 1 : sur toutes les cellules cel (noms) de la plage pl
    Set ln = cel.Offset(0, 1).Resize(, 18) 'définit la plage ln (cellules de la ligne du nom de cel sans le nom)
    nb = Application.WorksheetFunction.CountA(ln) 'définit le nombre de quantités renseignées dans la plage ln
    If nb > 0 Then 'condition 1 : si nb est supérieur à 0
        Set dest = Sheets("EXEMPLE").Cells(Application.Rows.Count, 4).End(xlUp).Offset(1, 0) 'définit la cellule de destination dest
        dest.Offset(0, -1).Value = cel.Value 'place le nom
        'mise en forme des contours du nom
        With Range(dest.Offset(0, -1), dest.Offset(nb - 1, -1))
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
        End With
        'mise en forme des contours du reste
        With Range(dest, dest.Offset(nb - 1, 1))
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Borders(xlInsideVertical).LineStyle = xlContinuous 'si une seule ligne, génère une erreur
            On Error Resume Next 'gestion des erreurs (si une erreur est générée passe à la ligne suivante)
            .Borders(xlInsideHorizontal).LineStyle = xlContinuous
            If Err <> 0 Then Err = 0 'si une erreur a été générée'annule l'erreur
            On Error GoTo 0 'annule la gestion des erreurs
        End With
        i = 0 'initialise l'incrément
        For Each celi In ln 'boucle 2 : sur toutes les cellules celi (quantités) de la plage ln
            If celi.Value <> "" Then 'condition 2 : si la cellule n'est pas vide
                dest.Offset(i, 0) = Sheets("LISTE").Cells(2, celi.Column) 'place le vêtement
                dest.Offset(i, 1) = celi.Value 'place la quantité
                i = i + 1 'incrément i
            End If 'fin de la condition 2
        Next celi 'prochaine cellule de la boucle 2
    End If 'fin de la condition 1
Next cel 'prochaine cellule de la boucle 1
Application.ScreenUpdating = True 'affiche les changements à l'écran
End Sub