Convertir un Tableau selon un format donné

Sub Macro1()
Dim os As Object 'déclare la variable os (Onglet Source)
Dim od As Object 'déclare la variable os d(Onglet Destination)
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim li As Long 'déclare la variable li (LIgne)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)
Dim ld As Long 'déclare la variable ld (Ligne du Début)
Dim r As Range 'déclare la variable r (Recherche)
Dim lf As Long 'déclare la variable lf (Ligne de Fin)

Set os = Sheets("Source") 'définit l'onglet source os (à adapter à ton cas)
Set od = Sheets("Destination") 'définit l'onglet destination od (à adapter à ton cas)
od.Range("A1").CurrentRegion.Clear 'efface les éventuelles anciennes données
dl = os.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 1 (=A) de l'onglet source
Set pl = os.Range("A1:A" & dl) 'définit la plage pl
For li = 1 To dl 'boucle sur toutes les lignes de 1 à dl
    'condition 1 : si la cellule en colonne A de la ligne li est égale à 0 et si elle est non vide
    If os.Cells(li, 1).Value = 0 And os.Cells(li, 1).Value <> "" Then
        'définit la cellule de destination dest (A1 si G1 est vide, sinon la première ligne où G est vide)
        Set dest = IIf(od.Range("G1").Value = "", od.Range("A1"), od.Cells(Application.Rows.Count, 7).End(xlUp).Offset(1, -6))
        os.Cells(li, 1).Resize(1, 6).Copy dest 'copie les 6 premières cellules de la ligne li et les colle dans dest
        os.Cells(li, 13).Resize(1, 6).Copy dest.Offset(0, 18) 'copie les autres cellules de la ligne li et les colle en colonne S
        ld = li + 1 'définit la ligne de début ld
        Set r = pl.Find(0, os.Cells(li, 1), xlValues, xlWhole) 'définit la recherche r
        If Not r Is Nothing Then 'condition 2 : si il existe au moins une occurrence trouvée dans la plage pl
            lf = IIf(r.Row > li, r.Row - 1, dl) 'définit la ligne de fin lf
            os.Range(os.Cells(ld, 1), os.Cells(lf, 12)).Copy dest.Offset(0, 6) 'copie la plage et la colle entre les colonnes éditées
        End If 'fin de la condition 2
        li = lf 'redéfinit la ligne li
    End If 'fin de la condition 1
Next li 'prochaine ligne li de la boucle
End Sub

Sub Macro1()
Dim os As Object 'déclare la variable os (Onglet Source)
Dim od As Object 'déclare la variable os d(Onglet Destination)
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim li As Long 'déclare la variable li (LIgne)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)
Dim ld As Long 'déclare la variable ld (Ligne du Début)
Dim r As Range 'déclare la variable r (Recherche)
Dim lf As Long 'déclare la variable lf (Ligne de Fin)
Dim x As Byte 'déclare la variable x (incrément)
Dim y As Byte 'déclare la variable y (incrément)


Set os = Sheets("Source") 'définit l'onglet source os (à adapter à ton cas)
Set od = Sheets("Destination") 'définit l'onglet destination od (à adapter à ton cas)
od.Range("A1").CurrentRegion.Clear 'efface les éventuelles anciennes données
dl = os.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 1 (=A) de l'onglet source
Set pl = os.Range("A1:A" & dl) 'définit la plage pl
For li = 1 To dl 'boucle 1 : sur toutes les lignes de 1 à dl
    'condition 1 : si la cellule en colonne A de la ligne li est égale à 0 et si elle est non vide
    If os.Cells(li, 1).Value = 0 And os.Cells(li, 1).Value <> "" Then
        'définit la cellule de destination dest (A1 si G1 est vide, sinon la première ligne où G est vide)
        Set dest = IIf(od.Range("A1").Value = "", od.Range("A1"), od.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
        os.Cells(li, 1).Resize(1, 18).Copy dest 'copie les 18 premières cellules de la ligne li et les colle dans dest
        If os.Cells(li + 1, 1).Value = 0 Then GoTo suite 'la ligne en dessous est égale à 0, va à l'étiquette "suite"
        ld = li + 1 'définit la ligne de début ld
        Set r = pl.Find(0, os.Cells(li, 1), xlValues, xlWhole) 'définit la recherche r
        If Not r Is Nothing Then 'condition 2 : si il existe au moins un occurrence dans la plage pl
            lf = IIf(r.Row > li, r.Row - 1, dl) 'définit la ligne de fin lf
            y = 0 'réinitialise la variable y
            For x = 1 To (lf - ld) + 1 'boucle 2 : sur les ressources
                os.Cells(li + x, 3).Copy dest.Offset(0, 18 + y) 'place le contenu de la colonne C en fin de ligne
                os.Cells(li + x, 12).Copy dest.Offset(0, 18 + y + 1) 'place le contenu de la colonne L en fin de ligne
                y = y + 2 'incrémente y
            Next x 'prochaine ressource de la boucle 2
        End If 'fin de la condition 2
        li = lf 'redéfinit la ligne li
    End If 'fin de la condition 1
suite: 'étiquette
Next li 'prochaine ligne li de la boucle
End Sub