Discussion :

[Malick]

Bonjour,

Débutant en VBA, je me lance dans la création d'un outil pour faire des remontées mensuelles de données comptables à partir d'une balance mensuelle.

La balance a la structure suivante :



Ce que je souhaite, c'est parcourir la colonne A afin d'identifier les informations relatives aux comptes commençant par 661 ou 662 ou 668. Une fois ces comptes identifiés, je souhaite copier le Numéro du compte, le libellé et le solde débit dans la feuille Personnel qui se présente comme suit :



J'aurai besoin de votre aide pour compléter le code que ci-après que je suis en train de faire :

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
 
 'Personnel
Sub ChargesDePersonnel()
    Dim DernLigne As Long
   Sheets("Balance").Select   'se positionner sur la feuille Balance
Range("A3").Activate    'se positionner sur le premier numéro de compte de la balance c'est-à-dire la cellule A3
y = 0
DernLigne = Sheets("Balance").Range("A65536").End(xlUp).Row 'Dernière ligne
 
'Remplissage de la feuille Personnel 
 
Sheets("Personnel").Select   'se positionner sur la feuille Personnel
Range("A6:A65536").EntireRow.Delete Shift:=xlUp 'Effacer toutes les lignes sur cette plage
 
While ActiveCell.Value <> ""
    If (Left(ActiveCell.Value, 3) = 661) Or (Left(ActiveCell.Value, 3) = 662) Or (Left(ActiveCell.Value, 3) = 668) Then
 
Wend
 
   End Sub

Merci d'avance pour votre aide

Cordialement,
Malick

[unparia]

Bonjour

Je te suggère d'y mettre (après ton "then") de quoi constituer une plage des colonnes à copier. Application.Union te le permet selon ce "modèle" :

Code :

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

Dim plage as range

Pour chaque occurrence 

  - si plage is nothing alors 
------ plage = tes cellules à copier
  - sinon
------ plage = Application.Union(plage, tes cdellules à copier)
Fin pour

Et à la fin :

plage.copy destination:= .........feuille et cellule à partir de laquelle doit se faire cette copie ...

[Promethee25]

Bonjour,

Une autre solution facile d'accès serait de piloter un filtre élaboré mais il faudrait que les entêtes de colonnes aient le même nom que la source:
http://philippetulliez.developpez.co...dvancedfilter/

[gFZT82]

Bonjour,

Et une solution de base

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
Sub ChargesDePersonnel()
Dim DernLigne As Long
Dim C As Range
Dim LigneC As Integer
    LigneC = 6
    With Sheets("Personnel")
        .Range(.Cells(LigneC, 1), .Cells(LigneC, 1).End(xlDown)).EntireRow.ClearContents
    End With
    With Sheets("Balance")
        DernLigne = .Range("A" & Rows.Count).End(xlUp).Row
        For Each C In .Range("A3:A" & DernLigne)
            If C.Value Like "661*" Or C.Value Like "662*" Or C.Value Like "668*" Then
                With Sheets("Personnel")
                    .Cells(LigneC, 1).Resize(, 2) = C.Resize(, 2).Value 'Copie du N° compte et libellé
                    .Cells(LigneC, 3) = C.Offset(, 6).Value 'Copie du solde débit
                    LigneC = LigneC + 1
                End With
            End If
        Next C
    End With
End Sub

Cordialement.

[Malick]

à tout le monde

D'abord je vous remercie pour votre disponibilité et vos retours.

@ unparia : merci pour cette proposition que je vais aussi exploiter

@ Promethee25 : merci. Je connaissais ce tutoriel, mais comme je cherche à l'automatiser alors j'ai opté pour le VBA.


@ gFZT82 : merci pour cette proposition, je vais essayer de l'adapter à mon fichier source et je vous ferais un retour

Cordialement,
Malick

[Marc-L]

Bonjour !

@ Promethee25 : merci. Je connaissais ce tutoriel, mais comme je cherche à l'automatiser alors j'ai opté pour le VBA.

Justement en lisant bien le tutoriel, il suffit de deux lignes de code afin d'effectuer ce genre de copie !
Rien qu'en utilisant l'Enregistreur de macros, une base de code (à nettoyer) est livrée sur un plateau …

Les titres des colonnes doivent être strictement identiques entre les deux feuilles ! Sinon il faut filtrer sur place puis copier …

Si vraiment tu ne t'en sors pas, malgré les nombreux exemples de filtres avancés dans ce forum VBA,
joindre un classeur exemple en .xlsx (sans code donc !) avec une feuille source et une feuille résultat attendu …

______________________________________________________________________________________________________
Je suis Paris, Charlie, Bruxelles, …

[Malick]

Marc-L

Bonjour !

Justement en lisant bien le tutoriel, il suffit de deux lignes de code afin d'effectuer ce genre de copie !
Rien qu'en utilisant l'Enregistreur de macros, une base de code (à nettoyer) est livrée sur un plateau …

Effectivement, et je n'avais pas pensé à l'enregistreur de macros. Merci pour cette précision Je vais aussi exploiter l'enregistreur de macros.

Bonjour !

Si vraiment tu ne t'en sors pas, malgré les nombreux exemples de filtres avancés dans ce forum VBA,
joindre un classeur exemple en .xlsx (sans code donc !) avec une feuille source et une feuille résultat attendu …

C'est noté. Je vous ferais un retour en fonction de mon avancement.

Cordialement

[Promethee25]

Tout à fait.
Quand j'ai écrit "piloter", j'entendais par là piloter un filtre élaboré avec VBA.

[Malick]

Exactement, merci pour cette précision également.

[Philippe Tulliez]

Bonjour,

Liste non exhaustive d'exemples et explications avec la méthode AdvancedFilter et contenant pour la plupart un classeur à télécharger

1. Dans la discussion nommée AdvancedFilter - Mise à jour de l'extraction aprés inscription de données dans une bdd
   
   • Exportation après modification dans une cellule
   • Exportation et activation d'un tableau avec synthèses par colonnes
2. Exportation en splittant les données répondant aux critères dans des feuilles séparées
3. Procédure de transfert de données (Exportation et suppression de la source)
4. Supprimer des lignes suivant critères avec la méthode AdvancedFilter

[Malick]

Philippe

Merci pour ces liens, je vais en prendre connaissance.

Cordialement,
Malick

[Malick]

Bonjour,

Je suis parti sur la proposition de gFZT82 qui fait bien ce que je voulais pour un mois donné. Maintenant, en voulant l'adapter à mon modèle qui sera constitué des balances mensuelles janvier, fevrier, ...décembre, je me heurte à un problème. J'explique :

En effet, pour un mois donné, la balance peut avoir de nouveaux comptes qui ne se trouvaient pas sur la balance du mois précédent. Ainsi, en exécutant le code pour remplir la colonne Mois+1 (ici février), je voudrais que tous les nouveaux comptes soient également copiés et que la colonne des mois pour lesquels ces comptes n'existaient pas affiche 0.

Le code pour faire le travail sur janvier et février est le suivant :

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
Option Explicit
'Remplissage Feuille Personnel Janvier
Sub ChargesDePersonnelJanvier()
Dim DernLigne As Long
Dim C As Range
Dim LigneC As Integer
    LigneC = 6
    With Sheets("Personnel")
        .Range(.Cells(LigneC, 1), .Cells(LigneC, 1).End(xlDown)).EntireRow.ClearContents
    End With
    With Sheets("BalanceJanvier")
        DernLigne = .Range("A" & Rows.Count).End(xlUp).Row
        For Each C In .Range("A3:A" & DernLigne)
            If C.Value Like "661*" Or C.Value Like "663*" Or C.Value Like "668*" Then
                With Sheets("Personnel")
                    .Cells(LigneC, 1).Resize(, 2) = C.Resize(, 2).Value 'Copie du N° compte et libellé
                    .Cells(LigneC, 3) = C.Offset(, 6).Value 'Copie du solde débit de la balance du mois de janvier
                    LigneC = LigneC + 1
                End With
            End If
        Next C
    End With
End Sub
'Remplissage Feuille Personnel Février
Sub ChargesDePersonnelFevrier()
Dim DernLigne As Long
Dim C As Range
Dim LigneC As Integer
    LigneC = 6
    'With Sheets("Personnel")
    '    .Range(.Cells(LigneC, 1), .Cells(LigneC, 1).End(xlDown)).EntireRow.ClearContents
   ' End With
    With Sheets("BalanceFevrier")
        DernLigne = .Range("A" & Rows.Count).End(xlUp).Row
        For Each C In .Range("A3:A" & DernLigne)
            If C.Value Like "661*" Or C.Value Like "663*" Or C.Value Like "668*" Then
                With Sheets("Personnel")
                    .Cells(LigneC, 1).Resize(, 2) = C.Resize(, 2).Value 'Copie du N° compte et libellé
                    .Cells(LigneC, 4) = C.Offset(, 4).Value 'Copie Mouvement débit de la balance Février
                    LigneC = LigneC + 1
                End With
            End If
        Next C
    End With
End Sub

En l'exécutant sur janvier, cela fonctionne bien :



Toutefois, l'exécution du code pour février entraîne un décalage entre les chiffres :



ici par exemple je voudrais que le compte 661035 ZAR m'affiche 0 sur janvier, idem pour les autres nouveaux comptes.

Une idée s'il vous plaît ?

Voici mon fichier test au format .xlsx

[gFZT82]

Re-bonjour,

Voici une adaptation des procédures prenant en compte tes remarques.

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
Option Explicit
Sub RAZ()
    With Sheets("Personnel")
        .Range(.Cells(6, 1), .Cells(6, 1).End(xlDown)).EntireRow.ClearContents
    End With
End Sub
'Remplissage Feuille Personnel Janvier
Sub CDP_Janvier()
    ChargesDePersonnel "BalanceJanvier", 1
End Sub
'Remplissage Feuille Personnel Fevrier
Sub CDP_Fevrier()
    ChargesDePersonnel "BalanceFevrier", 2
End Sub
Sub ChargesDePersonnel(NomMois As String, NumMois As Integer)
Dim DernLigne As Long
Dim C As Range, Cel As Range
Dim LigneC As Integer
    LigneC = 6
    With Sheets(NomMois)
        DernLigne = .Range("A" & Rows.Count).End(xlUp).Row
        For Each C In .Range("A3:A" & DernLigne)
            If C.Value Like "661*" Or C.Value Like "663*" Or C.Value Like "668*" Then
                With Sheets("Personnel")
                    Set Cel = .Columns(1).Find(C.Value, , xlValues, xlWhole)
                    If Not Cel Is Nothing Then
                        Cel.Offset(, NumMois + 1) = C.Offset(, 6).Value 'Copie du solde débit de la balance du mois
                    Else
                        LigneC = .Range("A" & Rows.Count).End(xlUp).Row + 1
                        .Cells(LigneC, 1).Resize(, 2) = C.Resize(, 2).Value 'Copie du N° compte et libellé
                        .Cells(LigneC, NumMois + 2) = C.Offset(, 6).Value 'Copie du solde débit de la balance du mois
                    End If
                End With
            End If
        Next C
    End With
End Sub

Cordialement.

[Malick]

Re-bonjour

Merci beaucoup, je vais essayer de l'adapter à ma situation. Je vous informerais du résultat.

Cordialement,
Malick

[Marc-L]

P'tite démonstration globale traitant toutes les balances présentes :

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
Sub Demo()
         Const MAX = 99
         Dim CPT(1 To MAX, 0), L%, R%, V, VA, W%, WN%
         WN = ThisWorkbook.Worksheets.Count
         ReDim COL(1 To MAX, 1 To WN)
    For W = 2 To WN
           VA = ThisWorkbook.Worksheets(W).Cells(1).CurrentRegion.Value
        For R = 3 To UBound(VA)
            If VA(R, 1) Like "661*" Or VA(R, 1) Like "662*" Or VA(R, 1) Like "668*" Then
                V = Application.Match(VA(R, 1), CPT, 0)
                If IsError(V) Then L = L + 1: CPT(L, 0) = VA(R, 1): COL(L, 1) = VA(R, 2): V = L
                COL(V, W) = VA(R, 7) - VA(R, 8)
            End If
        Next
    Next
         Application.ScreenUpdating = False
    With Feuil1.[A6].Resize(L, WN + 1)
        .Columns(1).Value = CPT
        .Columns(2).Resize(, WN).Value = COL
        .Sort .Cells(1), xlAscending, Header:=xlNo
    End With
         Application.ScreenUpdating = True
End Sub

[Malick]

+1
Après test sur mon fichier d'origine, les résultats obtenus sont concluants via cette méthode et le dernier code proposé.:Merci:

@ Marc : excellent ce code et il fait le remplissage des colonnes concernées d'un seul clic

Mais le souci avec ce dernier c'est qu'il ne prend en compte que deux balances. Mon fichier source aura pour chaque mois une balance, ce qui en fera 12 au total.



Pourrais-tu également mettre quelques commentaires pour que je puisse comprendre les différentes lignes ?

Merci encore pour la disponibilité et l'aide apportée.

[Marc-L]

As-tu testé mon code avec plus de 2 balances ? Ben non, évidemment ! Voir les lignes de code n°4 & 6 …
Et pourtant j'ai clairement indiqué avant le code : « P'tite démonstration globale traitant toutes les balances présentes » !

Dans la ligne de code n°10 Application.Match correspond à la fonction de feuille de calculs EQUIV (voir l'aide d'Excel) …

Pour le reste, mon code suivant exactement la même logique que gFZT82 à partir d'une variable tableau,
pour tout besoin d'aide sur une instruction, y positionner le curseur texte dans le VBE puis appuyer sur la touche !

Progresser dans le code en mode pas à pas via la touche F8 tout en contrôlant le contenu de la fenêtre Variables locales
aide aussi à comprendre son déroulement. Si vraiment cela ne suffit pas, indiques-moi le numéro de la ligne …

[Malick]

Bien noté Marc-L, je vais continuer à exploiter ta méthode et je t'informerais de mon avancement.

Par ailleurs, la proposition de gFZT82 permet de résoudre mon problème ; je passe la discussion en tout en continuant les tests avec ta méthode.

Merci encore à tous pour votre aide.

Cordialement,
Malick

[Marc-L]

Pour info, on peut éviter les douze boutons via un double clic sur le nom du mois dans la première feuille de calculs
en gérant son évènement Worksheet_BeforeDoubleClick …

[Malick]

C'est super et c'est un gain de temps. Je vais essayer d'appliquer cette méthode à mon fichier actuel pour voir ce que cela donne.