Fusion balances comptables

[Oliver77]

Bonjour,
J'utilise une macro (cf. bas de message) trouvée sur le site de Boisgontiers Jacques. J'ai inversé les onglets pour avoir en premier le libellé des comptes de l'exercice n.
Elle fonctionne très bien (Merci M. Boisgontiers).
Mon souci est que je ne veux pas récupérer les comptes dont le montant est à "0" sur les 2 exercices.
Je précise que j'ai les N° de comptes dans la colonne A, en B les libellés, et en C les montants.

Merci, par avance.
Oliver77.

Set onglet1 = Sheets("BalanceN")
Set onglet2 = Sheets("BalanceN_1")
Sheets("Balances").[A2:G1500].ClearContents
Range(onglet1.[A2], onglet1.[A65000].End(xlUp).Offset(0, 2)).Copy Sheets("Balances").[A2]
For Each c In Range(onglet2.[A2], onglet2.[A65000].End(xlUp))
p = Application.Match(c, [A:A], 0)
If IsError(p) Then
[A65000].End(xlUp).Offset(1, 0) = c
[A65000].End(xlUp).Offset(0, 1) = c.Offset(0, 1)
[A65000].End(xlUp).Offset(0, 3) = c.Offset(0, 2)
Else
[A1].Offset(p - 1, 3) = c.Offset(0, 2)
End If
Next c

 

[néné06]

Re : Fusion balances comptables

Bonsoir Olivier77 et bienvenue sur le Forum

Pourrais tu nous faire parvenir une pièce jointe "bidon" avec deux onglets et un petit descriptif de ce que tu as et ce que tu recherches.

Cordialement

 

[Oliver77]

Re : Fusion balances comptables

Bonsoir néné06,
Merci de te pencher sur mon cas. Je t'envoie une pièce jointe.
Comme tu pourras le constater j'ai un tas de procédures et je souhaite simplifier mon programme.

Oliver77

 

[néné06]

Re : Fusion balances comptables

En supprimant simplement dans la feuille 1 et 2 les lignes qui ont un solde à zéro, est-ce que cela ferait affaire ?

A+

 

[Oliver77]

Re : Fusion balances comptables

Non, je dois conserver les comptes dans les feuilles 1 et 2.

Merci.

 

[Oliver77]

Re : Fusion balances comptables

Je dois conserver les comptes dans les feuilles 1 & 2 pour 2 raisons :
1) Cela me permet de savoir si un compte a déjà été créé ;
2) En lançant mon programme, j'ai constaté que les plages dans mes formules (recherchev, index/equiv..) se modifiaient malgré le $.
J'utilisais la feuille 3 pour mes formules (recherchev, index/equiv..) ...
De ce fait, je pars des feuilles 1 et 2 pour mes autres feuilles de travail.

Merci par avance.

 

[Rep]

Re : Fusion balances comptables

Bonjour,

Pourquoi ne pas faire un tri sur la balance conso?

Une macro du type:

derniere_ligne=Range("A1").Currentregion.rows.count
For a = 1 to derniere_ligne
If Cells(a,3)=0 and Cells(a,4)= 0 Then
Rows(a).Select
Selection.Delete Shift:=xlUp
End If
Next a

 

[Oliver77]

Re : Fusion balances comptables

Bonjour,

Je fais un test et je te tiens au courant.

Merci.

 

[Oliver77]

Re : Fusion balances comptables

Re-bonjour Rep,

J'ai testé le code que tu m'as donné. Il ne supprime pas toutes les lignes.
J'essaie de le modifier pour voir.

Merci.

 

[Rep]

Re : Fusion balances comptables

Où as-tu intégré le code? J'ai fait un nouveau test avec le dernier fichier joint, ça fonctionne parfaitement.

 

[Oliver77]

Re : Fusion balances comptables

J'ai créé une procédure Sub Tri et je l'ai intégrée dans la procédure Sub fusion.
Le compte 129000 n'a pas été supprimé.
Je te transmets mon fichier.

Merci, par avance.

 

[Rep]

Re : Fusion balances comptables

Effectivement, petite correction apportée :

derniere_ligne=Range("A1").Currentregion.rows.count
For a = 1 to derniere_ligne
If Cells(a,3)=0 and Cells(a,4)= 0 Then
Rows(a).Select
Selection.Delete Shift:=xlUp
a = a-1
End If
Next a

 

[Oliver77]

Re : Fusion balances comptables

Merci,

Je fais plusieurs test avec d'autres balances.

Merci encore

 

[Oliver77]

Re : Fusion balances comptables

Salut Rep,

J'ai fais plusieurs tests, j'ai tenté de modifier la procédure en vain.
Rien à faire.
La boucle ne s'arrête pas avec la seconde solution que tu m'as proposée.

Merci,
Oliver77

 

[Rep]

Re : Fusion balances comptables

Re-bonjour,

Avec un peu de retard :

Sub tri()

derniere_ligne = Range("A1").CurrentRegion.Rows.Count

For a = 1 To derniere_ligne
If Cells(a, 3) = 0 And Cells(a, 4) = 0 And Cells(a, 3) <> "" And Cells(a, 4) <> "" Then
Rows(a).Select
Selection.Delete Shift:=xlUp
a = a - 1
End If
Next a

End Sub

Bonne journée