Microsoft 365 Création d'un journal d'écriture à partir d'un tableau des ventes

Sub Depivoter()
Set Dico = CreateObject("Scripting.Dictionary")
Dim TabData() As Variant
Dim TabFinal() As Variant
Dim IndF As Long

With Sheets("Listes").ListObjects(1) 'avec la table structurée de la feuille "Liste"
    For i = 1 To .ListRows.Count 'pour chaque ligne
        ele = UCase(.ListColumns(1).DataBodyRange.Rows(i)) 'on récupère le moyen de paiement==> En majuscule
        NumCompte = .ListColumns(2).DataBodyRange.Rows(i) 'son numéro de compte
        If Not Dico.exists(ele) Then 'on l'ajoute au dictionnaire en y associant le numéro
            Dico.Add ele, NumCompte
        End If
    Next i
End With

With ActiveSheet 'dans la feuille active
    fin = .Range("A" & .Rows.Count).End(xlUp).Row 'dernière ligne NON vide de la colonne A
    TabData = .Range("A2:O" & fin).Value 'on met tout dans un tableau vba
    'on place le numéro de compte à la place du mode de règlement
    For i = LBound(TabData, 1) + 4 To UBound(TabData, 1)
        TabData(i, 12) = Dico(UCase(TabData(i, 12)))
    Next i
    
    ReDim TabFinal(1 To (UBound(TabData, 1) - 4) * 9, 1 To 8) 'on définit le tableau final
    IndF = 1 'initialisation du numéro de ligne
    For i = LBound(TabData, 1) + 4 To UBound(TabData, 1) 'pour chaque ligne du tablo intial (à partir de la ligne 5)
        For j = 1 To 9 'pour les 9 colonnes de comptes, on remplit les 8 colonnes du tableau final
            TabFinal(IndF, 1) = "VE"
            TabFinal(IndF, 2) = TabData(i, 2)
            TabFinal(IndF, 3) = IIf(j = 1, TabData(i, 12), TabData(4, j + 2))
            TabFinal(IndF, 4) = ""
            TabFinal(IndF, 5) = TabData(i, 1)
            TabFinal(IndF, 6) = TabData(i, 15)
            TabFinal(IndF, 7) = IIf(j = 1, TabData(i, j + 2), "")
            TabFinal(IndF, 8) = IIf(j <> 1, TabData(i, j + 2), "")
            
            IndF = IndF + 1 'on passe à la ligne suivante
        Next j
    Next i
    
End With
With Sheets("Feuil3") 'dans la feuille 3
    .UsedRange.Offset(1, 0).Delete 'on efface tout sauf la ligne d'entete
    .Range("A2").Resize(UBound(TabFinal, 1), UBound(TabFinal, 2)) = TabFinal 'on colle le tableau final
    .Range("A1").Resize(UBound(TabFinal, 1) + 1, UBound(TabFinal, 2)).AutoFilter Field:=7, Criteria1:="=" 'on filtre la colonne 7
    .Range("A1").Resize(UBound(TabFinal, 1) + 1, UBound(TabFinal, 2)).AutoFilter Field:=8, Criteria1:="=" 'on filtre la colonne 8
    .Range("A2").Resize(UBound(TabFinal, 1), UBound(TabFinal, 2)).SpecialCells(xlCellTypeVisible).EntireRow.Delete 'on supprime les lignes qui n'ont ni débit, ni crédit
    .Cells.AutoFilter 'on enlève le filtre
End With
Sheets("Feuil3").Activate

Set Dico = Nothing
End Sub