Discussion :

[iliesss]

Bonjour
le code suivant permettre de ventiler les valeur après un filtre dans chaque feuil par rapport au numéro de compte

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Option Explicit
Sub ventiler()
Dim a, e, dico As Object, wsName As String
    Application.ScreenUpdating = False
    Set dico = CreateObject("Scripting.Dictionary")
    With Sheets("Regroupe")
        With .Range("a1").CurrentRegion
            With .Offset(1).Resize(.Rows.Count - 1)
                a = .Columns(5).Offset(1).Resize(.Rows.Count - 1).Value
                For Each e In a
                    If Not dico.exists(e) Then
                        dico(e) = Empty
                        wsName = e
                        If Not Evaluate("isref('" & wsName & "'!a1)") Then
                            Sheets.Add(after:=Sheets(Sheets.Count)).Name = wsName
                        End If
 
                        .AutoFilter 5, e
                        .SpecialCells(xlCellTypeVisible).Copy Sheets(wsName).Cells(8, 1)
                        .AutoFilter
                    End If
                Next
            End With
        End With
    End With
    Set dico = Nothing
    Application.ScreenUpdating = True
 
End Sub

mes feuil sont de la même forme


Apres l’exécution du code les lignes "TOTAUX" et "SOLDE COMPTABLE RECTIFI" et "DIFF" sont écraser par les nouvelles valeurs
j'ai essayé de remplacer l'expression

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

specialCells(xlCellTypeVisible).Copy

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.SpecialCells(xlCellTypeVisible).Insert Shift:=xlDown

mais ça marche pas

Aidez moi Svp

[Menhir]

Ce n'est pas le Copy qu'il faut remplacer par Insert mais le Paste.
Dans ton cas, le Paste est induit dans la méthode Copy. Il faut le séparer (en enlevant la destination de Copy).
Faire un Copy simple sur une ligne de code puis dans une autre ligne faire un Insert sur la destination.

[iliesss]

Salut Mr Menhir

Jai essayé cette solution

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
.SpecialCells(xlCellTypeVisible).Copy
.Sheets(wsName).Cells(8, 1).Insert shift:=xlDown

Mais vraiment je suis coincé
Aidez moi svp

[Menhir]

Jai essayé cette solution

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
.SpecialCells(xlCellTypeVisible).Copy
.Sheets(wsName).Cells(8, 1).Insert shift:=xlDown

Le point en début de ligne signifie que le code vient se mettre en continuité avec le contenu du dernier With.

Ta seconde ligne est donc équivalente à :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets("Regroupe").Range("a1").CurrentRegion.Offset(1).Resize(.Rows.Count - 1).Sheets(wsName).Cells(8, 1).Insert shift:=xlDown

Comme il est peu probable de placer un Sheet comme enfant d'un Range, le code n'est pas cohérent.

D'après le code que tu as mis en début de sujet, ce que tu as écris ci-dessus devrais aller si tu enlève ce point liminaire (mais laisse celui de la ligne Copy bien sûr).

Petit détail : la prochaine fois que tu indiques un problème, ne te contente pas de dire "je suis coincé". Précise le message d'erreur renvoyé et la ligne de code signalée par le débugage. Ca facilite grandement les chances de repérer le problème.

[iliesss]

SAlut Mr Menhir
J'ai essayer mille fois et même avec ca

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
.SpecialCells(xlCellTypeVisible).Copy
Sheets(wsName).Cells(8, 1).Insert shift:=xlDown

mais j'ai rien comme resultat

[John Mc Evee]

Bonsoir iliesss,

Après avoir étudier ton code, j'avoue j'ai eu du mal à piger la logique (propre à chacun ). Surtout cette partie ci dessous :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 With .Range("a1").CurrentRegion
       With .Offset(1).Resize(.Rows.Count - 1)
        '.....
       End With
End With

Donc je te propose un code qui copie des données en fonction d'une liste de compte (feuille regroupe) et qui les répartir par feuille.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
Option Explicit
'**************************************************************************************************
' NAME : Ventiler (PROCESS)
' DESCRIPTION : A partir d'une liste de compte, le processus va répartir les
' différentes lignes dans les feuilles associées (La jonction se fait par le
' nom de la feuille)
'**************************************************************************************************
Public Sub Ventiler()
 
    Dim oSheetData   As Excel.Worksheet  'Feuille avec le numéro du compte
    Dim oRangeData   As Excel.Range      'Plage des cellules à copier
    Dim oListAccount As Object           'Liste des comptes à exporter
    Dim oCellAccount As Object           'Cellule du compte actif
    Dim oTestAccount As Object           'Liste des comptes déjà testé
    Dim iLastRow     As Integer          'dernière ligne de la colonne 5 (feuille regroupe)
    Dim iFirstRow    As Integer          'Ligne des entêtes (feuille regroupe)
    Dim iLastColumn  As Integer          'Dernière colonne non vide sur la ligne des entêtes
    Dim iFirstColumn As Integer          'Première colonne à exporter
    Dim iNumberRow   As Integer          'Nombre de ligne à exporter
 
    Application.ScreenUpdating = False
 
    'Paramétrage
    iFirstRow = 8 ' Saisir la ligne de tes en-têtes
    iFirstColumn = 1 'Saisir la première colonne de copie
 
    Set oTestAccount = VBA.CreateObject("Scripting.Dictionary")
 
    With Worksheets("Regroupe")
 
        If .FilterMode Then 'Si il y a un filtre d'activer
            .ShowAllData
        End If
 
        'Calcul de la plage
        iLastRow = .Cells(65000, 5).End(xlUp).Row
        iLastColumn = .Cells(iFirstRow, 255).End(xlToLeft).Column
 
        'Fixation de la plage
        Set oListAccount = .Range(.Cells(iFirstRow + 1, 5), .Cells(iLastRow, 5))
 
        For Each oCellAccount In oListAccount
 
            If Not oTestAccount.Exists(oCellAccount.Value) Then
                oTestAccount(oCellAccount.Value) = Empty
 
                'On initialise la feuille de destination
                On Error Resume Next
                Set oSheetData = Worksheets(CStr(oCellAccount))
                'Si elle n'existe pas on la créé
                If oSheetData Is Nothing Then
                    Set oSheetData = Sheets.Add(After:=Sheets(Sheets.Count))
                    oSheetData.Name = oCellAccount
                End If
 
                'Application du filtre
                .Range(iFirstRow & ":" & iFirstRow).AutoFilter 5, oCellAccount
 
                'Fixation de la plage à exporter
                Set oRangeData = .Range(.Cells(iFirstRow + 1, iFirstColumn), _
                                 .Cells(iLastRow, iLastColumn)).SpecialCells(xlCellTypeVisible)
 
                oRangeData.Copy 'Copie des données
 
                'On récupère le nombre de ligne à exporter
                iNumberRow = oRangeData.Rows.Count
 
                'Insertion des lignes dans la nouvelle feuille
                oSheetData.Rows("9:" & 9 + iNumberRow).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
 
                Set oSheetData = Nothing
                Set oRangeData = Nothing
 
            End If
 
        Next oCellAccount
 
        .ShowAllData
 
        Set oListAccount = Nothing
        Set oTestAccount = Nothing
 
    End With
 
End Sub

Avec le fichier de test ci-joint : Ventiler.xlsm

En espérant avoir saisie ton problème de ventilation (au passage un terme très comptable ).

A+

[iliesss]

Mille Merci Mr avec ton code et ton fichier tu ma gagner beaucoup de temps
demain au bureau je vais tester avec tous mes comptes

[iliesss]

Bonjour Mr John Mc Egée
j'ai essayé avec tous les comptes de mon Grand livre et ça marche très très bien
Mille merci pour ce joli travail

[John Mc Evee]

Bonjour,

Au plaisir de me pencher sur des problématiques comptables

A+

[iliesss]

Bonjour
Merci beaucoup Mr
je prépare une autre question au but de regrouper et après ventilé les données
ET bien sûr je vais utilisé votre code ventilé et je prépare le code regrouper et lorsque je termine le fichier je vais le partager avec vous

[John Mc Evee]

Merci d'avance

[iliesss]

Bonjour Mr John
Je suis un comptable et chaque fin du mois je ventile mon grand livre par compte et le fichier suivant c’est la ventilation des comptes arrêté au mois juin 2018
A la fin du mois juillet 2018 je copié mon grand livre (fichier Excel spéciale pour notre entreprise) dans la feuil "Regroupe" et ensuite votre code ventile les donner par numéro de compte
A la fin de doit ajouter les fonctions suivantes pour tous les feuil sauf Regroupe
1-

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range ("G6").value = range ("I9").end(xlDown).value

c.-à-d.(la dernier cellule dans la colonne I)
2- Totaux Dédit (la somme "G9" à la dernière cellule G) j'ai essayé ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("G9").End(xlDown).Offset(2, 0).Formula = "=SUM(G9:" & Range("G9").End(xlDown).Address(0, 0) & ")"

3- Totaux Crédit (la somme "H9" à la dernière cellule H) j'ai essayé ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("H9").End(xlDown).Offset(2, 0).Formula = "=SUM(H9:" & Range("H9").End(xlDown).Address(0, 0) & ")"

4- Solde comptable rectifié (Totaux Dédit- Totaux Crédit)
5- Différence ("G6" - Solde comptable rectifié)
6- Columns("i :J").Delete

J'ai rester des heures pour faire ce travail mais votre code ma beaucoup gagner du temps
merci encore une fois

[MarcelG]

Bonjour,

Le code de John est bien construit.

Juste pour information.
2 méthodes étaient également envisageables
- Alimentation de la zone de critère d'un filtre élaboré (avancé) par chaque occurrence du dictionnaire et copie de la feuille filtrée
- Création des feuilles par le dictionnaire, leur alimentation s'effectuant par variable tableau.
Voir cette modeste contribution

[John Mc Evee]

Bonjour iliesss,

Juste quelques petites questions :

Je ne saisis pas la logique de la colonne I. Tu veux faire un report du solde de fin de mois en G6 mais il n'y a pas de données dans la colonne I ? Mais plutôt la valeur de ton solde rectifié ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range ("G6").value = range ("I9").end(xlDown).value

dans "6- Columns("i :J").Delete" cela concerne ta feuille Regroupe ?

Dans tes cellules de totaux tu as besoin d'inscrire la formule ou la valeur suffit ?

Dans le cas d'un nouveau compte tu es rajoute manuellement la mise en forme ?

[iliesss]

La colonne i dans la feuil "regrouper" est le solde de chaque comptes c-a-d
Si je mets un filtre pour n'importe quel compte la dernière valeur de la colonne I est le solde final du mois
Donc c'est la valeur de G6 de chaque feuil

Les cellules totaux j'ai besoin la formule
Oui j'ajoute manuellement les mise en forme si non j'enregistre un macro pour ça
Désolé je suis en voiture dès que je rentre a la maison je vous donne plus de détails
Mille merci

[John Mc Evee]

Dsl je n'avais pas appliquer la macro. Je vois mieux ce que tu veux faire

[iliesss]

Bonjour,

Le code de John est bien construit.

Oui un très joli travail et il m'a beaucoup aider

[John Mc Evee]

Re iliesss,

Voilà le résultat, je me suis inspirer de tes idées de code pour construire le processus.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
'**************************************************************************************************
' NAME : Consolider (PROCESS)
' DESCRIPTION : Le processus va parcourir toute les feuilles du classeur afin d'effectuer 
' différentes tâches :
' 1 - Reporter le solde de fin de mois situé dans la colonne I de la feuille regroupe
' 2 - Effectuer les totaux des débits et crédits
' 3 - Calculer le solde de fin de mois
' 4 - Calculer la différence entre le solde théorique et rectifié
' 5 - Supprimer les colonnes I:J de la feuille Regroupe
'**************************************************************************************************
Public Sub Consolider()
 
 
    Dim oSheetData    As Excel.Worksheet 'Feuille avec le numéro du compte
    Dim oTotalDebit   As Excel.Range     'Cellule du total de la colonne Débit
    Dim oTotalCredit  As Excel.Range     'Cellule du total de la colonne Crédit
    Dim oSoldeAccount As Excel.Range     'Cellule du solde comptable
    Dim oSoldeRectif  As Excel.Range     'Cellule du solde comptable rectifié
    Dim oSoldeDiff    As Excel.Range     'Cellule du différenciel
    Dim sSolde        As String          'Valeur du solde de fin de mois
 
    'Boucle sur toutes les feuilles du classeur
    For Each oSheetData In ThisWorkbook.Worksheets
 
        With oSheetData
 
            'Exclusion des feuilles noms concernées par la procédure
            If .Name <> "Regroupe" And .Name <> "Masque" Then
 
                '----------------------------1 - Solde Comptable-----------------------------'
                Set oSoldeAccount = .Range("G6")
                'On récupère le solde du compte en colonne I
                sSolde = .Cells(.Cells(.Rows.Count, 9).End(xlUp).Row, 9).Value
                'Affectation du nouveau solde
                oSoldeAccount.Value = sSolde
 
                '----------------------------2 - Crédit--------------------------------------'
                ' Fixe de la cellule Totaux Crédit
                Set oTotalCredit = .Range("H8").End(xlDown).Offset(2, 0)
                'Ecriture de la somme dans la cellule
                oTotalCredit.Formula = "=SUM(H9:" & oTotalCredit.Offset(-2, 0).Address & ")"
 
                '----------------------------2 - Débit----------------------------------------'
                ' Fixe de la cellule Totaux Debit en partant des Totaux Crédit
                Set oTotalDebit = oTotalCredit.Offset(0, -1)
                'Ecriture de la somme dans la cellule
                oTotalDebit.Formula = "=SUM(G9:" & oTotalDebit.Offset(-2, 0).Address & ")"
 
                '----------------------------3 - Solde Rectifié------------------------------'
                ' Fixe de la cellule Solde Comptable en partant du Total Débit
                Set oSoldeRectif = oTotalDebit.Offset(1, 0)
                'Calcul du solde comptable
                oSoldeRectif.Formula = "=" & oTotalDebit.Address & "-" & oTotalCredit.Address
 
                Set oTotalCredit = Nothing 'Vidange
                Set oTotalDebit = Nothing
 
                '----------------------------4 - Différenciel-----------------------------------'
                'Fixe de la cellule Différence en partant du solde comptable
                Set oSoldeDiff = oSoldeRectif.Offset(1, 0)
                'Calcul du différentel entre les deux soldes
                oSoldeDiff.Formula = "=" & oSoldeAccount.Address & "-" & oSoldeRectif.Address
 
                Set oSoldeRectif = Nothing 'Vidange
                Set oSoldeDiff = Nothing
                Set oSoldeAccount = Nothing
 
                '5 - Suppression des colonnes
                .Columns("I:J").Delete
 
            End If
 
        End With
 
    Next oSheetData
 
End Sub

Il me reste cependant une interrogation, l'insertion des nouvelles lignes c'est pour conserver les mois précédents sinon tu vas avoir des gros décalage entre le solde et le rectifié ?

Je t'ai ajouter une feuille appelé masque qui te permet de gérer ton format de départ (Tu peux ajouter de la mise en forme conditionnel ou des formats de monétaire,..).
En cas de nouveau compte c'est cette feuille qui sera dupliqué (Fini la mise en forme à répétition )

Avec le fichier de test VentilerV3.xlsm

A+

[iliesss]

Waaaooooow incroyable
je ne trouve pas les mots pour exprimer ou pour vous remercier c'est juste ce que je cherche de puis des longue temps.

Non je n'ai pas avoir des gros décalage entre le solde et le rectifié. parce-que je doit faire un rapprochement entre le débit et le crédit et éliminer les montant égaux et a la fin des écritures comptable manuelle pour ajouter le solde

Svp comment mettre le solde comptable de la cellule G6 en format Nombre de décimales

[John Mc Evee]

Insérer cette ligne à cet emplacement.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
'----------------------------1 - Solde Comptable-----------------------------'
 Set oSoldeAccount = .Range("G6")
 oSoldeAccount.NumberFormat = "#,##0.00" 'Ligne a ajouter

Ravi de vous avoir aidé. Ce qui est bien avec l’automatisation c'est qu'on est payé le même prix pour 10X moins de temps