Compilaton de plusieurs feuilles excel

Sylvie

Sylvie

XLDnaute Accro
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
 

Pièces jointes

  • Dossier Balances mensuelles.xlsx
    158.4 KB · Affichages: 43
Trier par date Trier par votes
Pierrot93

Pierrot93

XLDnaute Barbatruc
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
Cliquez pour agrandir...

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
@+
 
Vote positif 0 Vote négatif
Pierrot93

Pierrot93

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
Paf

Paf

XLDnaute Barbatruc
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+
 
Vote positif 0 Vote négatif
Sylvie

Sylvie

XLDnaute Accro
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
 

Pièces jointes

  • Dossier Balances mensuelles.xlsm
    167.3 KB · Affichages: 32
Vote positif 0 Vote négatif
Sylvie

Sylvie

XLDnaute Accro
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
 
Vote positif 0 Vote négatif
Paf

Paf

XLDnaute Barbatruc
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+
 
Vote positif 0 Vote négatif
Sylvie

Sylvie

XLDnaute Accro
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
 
Vote positif 0 Vote négatif
Paf

Paf

XLDnaute Barbatruc
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
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

B
  • Question
XL 2013 Transposition de filtres multiples sur plusieurs feuilles
Réponses
11
Affichages
248
BIROULIG
B
V
  • Résolu(e)
XL 2021 Complétion d'un tableau automatisée
Réponses
9
Affichages
655
VincentH.DR
V
abtony
  • Question
XL 2019 Besoin d'aide correction de code VBA
Réponses
3
Affichages
438
abtony
abtony
S
  • Question
Microsoft 365 Afficher dans un tableau les noms des feuilles d'un fichier excel ainsi que le nombre de lignes renseignées pour chacune d'elle.
Réponses
2
Affichages
359
chris
chris
F
  • Question
Microsoft 365 Regrouper certaines colonnes de plusieurs feuilles en une seule
Réponses
0
Affichages
639
flo33200
F
M
  • Résolu(e)
XL 2010 Faire un sommaire à partir de plusieurs feuilles
Réponses
8
Affichages
880
JHA
J
L
  • Résolu(e)
Microsoft 365 Macro copie de lignes entières d'un onglet général vers onglets détaillés à partir d'une colonne oui/non
Réponses
9
Affichages
1 K
job75
job75
ymanot
  • Question
XL 2016 Macro mise en forme sur un filtre macro de tri
Réponses
0
Affichages
457
ymanot
ymanot
Droopyougo
  • Question
Microsoft 365 Copier la valeur de cellules non contigües de plusieurs feuilles vers une feuille récapitulative.
Réponses
14
Affichages
718
Droopyougo
Droopyougo
A
  • Résolu(e)
Microsoft 365 Extraire différentes colonnes de plusieurs feuilles
Réponses
7
Affichages
1 K
cp4
cp4

Membres actuellement en ligne

27 membres et 175 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 194
Messages
2 086 066
Membres
103 110
dernier inscrit
Privé