Compilaton de plusieurs feuilles excel

Sylvie · 7 Octobre 2015

Bonjour Cher Forum,

Voilà un bail que je ne t'étais pas revenue activement sur le forum. C'est magnifique, le forum tourne à plein régime grâce à vous tous.

Je vous expose mon problème:
J'ai regroupé sur un même classeur excel et sur 10 feuilles, 10 balances de 06.2015 à 09.2014.
Toutes les feuilles ont la même structure mais pas le même nombre de lignes car certains comptes (au sens plan comptable) peuvent être absents d'un mois sur l'autre et les lignes n'apparaissent donc pas (compte, libellé, mvt debit, mvt credit, solde débit et solde crédit).

J'ai determiné sur la dernière feuille intitulé "plan comptable" l'ensemble des comptes ayant pu être utilisés dans l'une des 10 feuilles (je suis passée par un tableau croisé dynamique pour concatener mes 10 feuilles afin d'extraite le plan comptable type : sans doute y avait plus simple ??) : 646 comptes composent mon plan comptable et environ 450 ont du être utilisés au total sur les 10 balances

Je souhaite sur chacune des 10 feuilles
ajouter dans la colonne 1 les numéros de compte manquants
ajouter dans la colonne 2 le nom du compte
ajouter dans les colonnes 3 à 6 la valeur 0

A coup sur une brillante macro me permettrait de procéder rapidement, mais mes connaissances en VBA n'ont pas progressé avec le temps.

Si il y a également une solution plus rapide pour extraire sur une feuille tous les numéros de compte et libéllés de compte (col 1 et col 2) utilisés dans mes 10 balances, je suis preneuse de l'astuce.

Merci Beaucoup pour votre aide

Pierrot93 · 7 Octobre 2015

Re : Compilaton de plusieurs feuilles excel

Bonjour Sylvie,

Je souhaite sur chacune des 10 feuilles
ajouter dans la colonne 1 les numéros de compte manquants
ajouter dans la colonne 2 le nom du compte
ajouter dans les colonnes 3 à 6 la valeur 0

regarde peut être ceci, attention il y a une espace dans le nom de ta feuille "PLAN COMPTABLE" :

Code:

Option Explicit
Sub test()
Dim ws As Worksheet, c As Range, x As Range
For Each ws In Worksheets
    If ws.Name Like "BAL*" Then
        With ws
            On Error Resume Next
            For Each c In .Range("A1:A" & .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), xlValues, , 1, 2, 0).Row).SpecialCells(xlCellTypeBlanks)
                Set x = Worksheets("PLAN COMPTABLE").Columns(2).Find(c.Offset(0, 1), , xlValues, xlWhole, , , False)
                If Not x Is Nothing Then c = x.Offset(0, -1)
            Next c
            For Each c In .Range("B1:B" & .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), xlValues, , 1, 2, 0).Row).SpecialCells(xlCellTypeBlanks)
                Set x = Worksheets("PLAN COMPTABLE").Columns(1).Find(c.Offset(0, -1), , xlValues, xlWhole, , , False)
                If Not x Is Nothing Then c = x.Offset(0, 1)
            Next c
            .Range("C1:F" & .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), xlValues, , 1, 2, 0).Row).SpecialCells(xlCellTypeBlanks).Value = 0
            On Error GoTo 0
        End With
    End If
Next ws
End Sub

bon après midi
@+

Pierrot93 · 7 Octobre 2015

Re : Compilaton de plusieurs feuilles excel

Re,

avec la reprise des comptes sur l'onglet "PLAN COMPTABLE", préférable que celui ci est 1 ligne de titre :

Code:

Option Explicit
Sub test()
Dim ws As Worksheet, c As Range, x As Range

For Each ws In Worksheets
    If ws.Name Like "BAL*" Then
        With Worksheets("PLAN COMPTABLE")
            ws.Range("A1:B" & ws.Cells.Find("*", ws.Cells(.Rows.Count, ws.Columns.Count), xlValues, , 1, 2, 0).Row).Copy _
                Destination:=.Cells(.Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), xlValues, , 1, 2, 0).Row, 1)(2)
        End With
    End If
Next ws

With Worksheets("PLAN COMPTABLE")
    With .Range("A1:B" & .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), xlValues, , 1, 2, 0).Row)
        .RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
        .Sort Worksheets("PLAN COMPTABLE").Range("A1"), xlAscending, Header:=xlYes
    End With
End With

For Each ws In Worksheets
    If ws.Name Like "BAL*" Then
        With ws
            On Error Resume Next
            For Each c In .Range("A1:A" & .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), xlValues, , 1, 2, 0).Row).SpecialCells(xlCellTypeBlanks)
                Set x = Worksheets("PLAN COMPTABLE").Columns(2).Find(c.Offset(0, 1), , xlValues, xlWhole, , , False)
                If Not x Is Nothing Then c = x.Offset(0, -1)
            Next c
            For Each c In .Range("B1:B" & .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), xlValues, , 1, 2, 0).Row).SpecialCells(xlCellTypeBlanks)
                Set x = Worksheets("PLAN COMPTABLE").Columns(1).Find(c.Offset(0, -1), , xlValues, xlWhole, , , False)
                If Not x Is Nothing Then c = x.Offset(0, 1)
            Next c
            .Range("C1:F" & .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), xlValues, , 1, 2, 0).Row).SpecialCells(xlCellTypeBlanks).Value = 0
            On Error GoTo 0
        End With
    End If
Next ws
End Sub

Paf · 7 Octobre 2015

Re : Compilaton de plusieurs feuilles excel

Bonjour Sylvie, Pierrot93

Une version dictionary

Pour regrouper les Comptes sur la feuille "PLAN COMPTABLE "

Code:

Sub Regroupement()
 Dim MonDico, MonTab, i, j
 Set MonDico = CreateObject("Scripting.Dictionary")
 For i = 1 To Worksheets.Count - 1
    With Worksheets(i)
    MonTab = .Range("A1:B" & .Range("A" & Rows.Count).End(xlUp).Row)
    For j = LBound(MonTab) To UBound(MonTab)
        MonDico(MonTab(j, 1)) = MonTab(j, 2)
    Next
    End With
 Next

 Worksheets("PLAN COMPTABLE ").Range("A1").Resize(MonDico.Count, 1) = Application.Transpose(MonDico.keys)
 Worksheets("PLAN COMPTABLE ").Range("B1").Resize(MonDico.Count, 1) = Application.Transpose(MonDico.items)
End Sub

pour rajouter les Comptes manquants sur chaque feuille

Code:

Sub Repartition()
 Dim MonDicoG, MonDicoL, MonTab, Code, TabFin()
 Dim DerL As Long, i As Long, j As Long, x As Integer, k As Byte
 Set MonDicoG = CreateObject("Scripting.Dictionary")
 Set MonDicoL = CreateObject("Scripting.Dictionary")


 With Worksheets("PLAN COMPTABLE ")
 MonTab = .Range("A1:B" & .Range("A" & Rows.Count).End(xlUp).Row)
 For i = LBound(MonTab) To UBound(MonTab)
    MonDicoG(MonTab(i, 1)) = MonTab(i, 2)
 Next
 End With
 Erase MonTab

 For i = 1 To Worksheets.Count - 1
    x = 0
    MonDicoL.RemoveAll
    With Worksheets(i)
    DerL = .Range("A" & Rows.Count).End(xlUp).Row
    MonTab = .Range("A1:B" & DerL)
    For j = LBound(MonTab) To UBound(MonTab)
        MonDicoL(MonTab(j, 1)) = MonTab(j, 2)
    Next
    For Each Code In MonDicoG.keys
        If Not MonDicoL.exists(Code) Then
            x = x + 1
            ReDim Preserve TabFin(1 To 6, 1 To x)
            TabFin(1, x) = Code
            TabFin(2, x) = MonDicoG(Code)
            For k = 3 To 6
                TabFin(k, x) = 0
            Next
        End If
    Next
    If x > 0 Then .Range("A" & DerL + 1).Resize(x, 6) = Application.Transpose(TabFin)
        Erase TabFin
    End With
 Next
End Sub

A+

Sylvie · 7 Octobre 2015

Re : Compilaton de plusieurs feuilles excel

Bonjour Pierrot,

Merci beaucoup pour ton aide.
Peut être m'y suis je mal prise pour intégrer ta macro dans mon fichier car cela ne semble pas fonctionner : aucune des 10 balances sur les 10 feuilles n'a été complétée par des lignes à 0 avec numéro plan compte et libéllé seuls renseigner dans col 1 et 2.

Peut être aurais je du coller ta macro dans This Worbook ?

Je t'adresse le fichier avec ta macro telle que je l'ai intégrée.

Merci

Pierrot93 · 7 Octobre 2015

Re : Compilaton de plusieurs feuilles excel

Re,
bonjour Paf

euh... je crois que j'ai rien compris car à priori tes 4 dernières feuilles sont complètes (colonnes A et B)...

Sylvie · 7 Octobre 2015

Re : Compilaton de plusieurs feuilles excel

Bonjour Paf, Re bonjour Pierrot93

Excuse moi Paf, mais je n'avais pas vu ta réponse.
Merci beaucoup, c'est exactement ce que je voulais. J'ai effectivement corrigé mon espace sur la Feuille Plan Comptable et tout fonctionne à merveille.

Comme j'aimerais avoir ne serait ce un tantième de vos compétences : je vous envie et je vous remercie tous deux vivement
Vous m'otez une belle épine du pied.

Pensez vous qu'il soit possible uniquement avec les 10 feuilles de balance (sans la feuille plan comptable) de compléter chacune des balances de la même façon en y ajoutant les comptes qui existent sur les autres feuilles et qui peuvent être absents sur l'une d'elle ?

Là ca serait encore plus génial car je pourrais automatiser cela pour l'ensemble de mes dossiers.

Merci

Pierrot93 · 7 Octobre 2015

Re : Compilaton de plusieurs feuilles excel

Re,

AArf je viens de comprendre.... à coté de la plaque moi... désolé...

Paf · 7 Octobre 2015

Re : Compilaton de plusieurs feuilles excel

Re,

La même fonctionnalité sans passer par la feuille Plan Comptable

Code:

Sub Repartition()
 Dim MonDicoG, MonDicoL, MonTab, Code, TabFin()
 Dim DerL As Long, i As Long, j As Long, x As Integer, k As Byte
 Set MonDicoG = CreateObject("Scripting.Dictionary")
 Set MonDicoL = CreateObject("Scripting.Dictionary")

 '**** Regroupement des comptes sans doublon
 For i = 1 To Worksheets.Count - 1
    With Worksheets(i)
    MonTab = .Range("A1:B" & .Range("A" & Rows.Count).End(xlUp).Row)
    For j = LBound(MonTab) To UBound(MonTab)
        MonDicoG(MonTab(j, 1)) = MonTab(j, 2)
    Next
    End With
 Next

 '**** répartition des manquants sur chaque feuille
 Erase MonTab

 For i = 1 To Worksheets.Count - 1
    x = 0
    MonDicoL.RemoveAll
    With Worksheets(i)
    DerL = .Range("A" & Rows.Count).End(xlUp).Row
    MonTab = .Range("A1:B" & DerL)
    For j = LBound(MonTab) To UBound(MonTab)
        MonDicoL(MonTab(j, 1)) = MonTab(j, 2)
    Next
    For Each Code In MonDicoG.keys
        If Not MonDicoL.exists(Code) Then
            x = x + 1
            ReDim Preserve TabFin(1 To 6, 1 To x)
            TabFin(1, x) = Code
            TabFin(2, x) = MonDicoG(Code)
            For k = 3 To 6
                TabFin(k, x) = 0
            Next
        End If
    Next
    If x > 0 Then .Range("A" & DerL + 1).Resize(x, 6) = Application.Transpose(TabFin)
        Erase TabFin
    End With
 Next
End Sub

A+

Sylvie · 7 Octobre 2015

Re : Compilaton de plusieurs feuilles excel

Re bonjour,

Merci beaucoup Paf : c'est en tout point remarquable et fonctionnel.
Est il possible d'ajouter deux modules optionnels que j'utiliserais ou non :
1) Colorier en jaune par exemple tous les comptes qui ont été ainsi rajoutés dans chaque feuille
2) Refaire un tri de la balance selon la colonne 1

Le premier, mettre en évidence les comptes rajoutés va m’être de toutes façons utile.

Merci encore

Paf · 7 Octobre 2015

Re : Compilaton de plusieurs feuilles excel

Re,

Code:

Sub LaMacro_qui_Regroupe_Repartit_Colorie_Trie()
 Dim MonDicoG, MonDicoL, MonTab, Code, TabFin()
 Dim DerL As Long, i As Long, j As Long, x As Integer, k As Byte
 Set MonDicoG = CreateObject("Scripting.Dictionary")
 Set MonDicoL = CreateObject("Scripting.Dictionary")

 '**** Regroupement des comptes sans doublon
 For i = 1 To Worksheets.Count - 1
    With Worksheets(i)
    MonTab = .Range("A1:B" & .Range("A" & Rows.Count).End(xlUp).Row)
    For j = LBound(MonTab) To UBound(MonTab)
        MonDicoG(MonTab(j, 1)) = MonTab(j, 2)
    Next
    End With
 Next
 '**** repartition des manquants
 Erase MonTab

 For i = 1 To Worksheets.Count - 1
    x = 0
    MonDicoL.RemoveAll
    With Worksheets(i)
    DerL = .Range("A" & Rows.Count).End(xlUp).Row
    MonTab = .Range("A1:B" & DerL)
    For j = LBound(MonTab) To UBound(MonTab)
        MonDicoL(MonTab(j, 1)) = MonTab(j, 2)
    Next
    For Each Code In MonDicoG.keys
        If Not MonDicoL.exists(Code) Then
            x = x + 1
            ReDim Preserve TabFin(1 To 6, 1 To x)
            TabFin(1, x) = Code
            TabFin(2, x) = MonDicoG(Code)
            For k = 3 To 6
                TabFin(k, x) = 0
            Next
        End If
    Next
 
    If x > 0 Then
        .Range("A" & DerL + 1).Resize(x, 6) = Application.Transpose(TabFin)
        .Range("A" & DerL + 1 & ":F" & DerL + x).Interior.ColorIndex = 6 ' option colorier
    End If
    .Range("A1:F" & DerL + x).Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlGuess ' option trier
    Erase TabFin
    End With
 Next
End Sub

Inutile de rajouter d'autres traitements, il n'y a plus de place dans le nom de la macro.

A+

Edit: Oupsss ! je n'ai pas pris en compte le souci des options. Copier la macro puis supprimer la ou les options dans les copies, et modifier le nom de la macro

Sylvie · 7 Octobre 2015

Re : Compilaton de plusieurs feuilles excel

Merci beaucoup Paf. Je vais tester tout cela.

Bonne soirée

Compilaton de plusieurs feuilles excel

Sylvie

XLDnaute Accro

Pièces jointes

Pierrot93

XLDnaute Barbatruc

Pierrot93

XLDnaute Barbatruc

Paf

XLDnaute Barbatruc

Sylvie

XLDnaute Accro

Pièces jointes

Pierrot93

XLDnaute Barbatruc

Sylvie

XLDnaute Accro

Pierrot93

XLDnaute Barbatruc

Paf

XLDnaute Barbatruc

Sylvie

XLDnaute Accro

Paf

XLDnaute Barbatruc

Sylvie

XLDnaute Accro

Discussions similaires