modifier une fonction crée en vba

rimbaut

XLDnaute Nouveau
Bonsoir,
J'ai écrit ce code qui fonctionne pas trop mal et qui consiste à comparer 2 plages de cellules qui se trouvents sur 2 feuilles différentes d'un même classeur.
Ce code consiste à comparer des numéros de comptes de la feuille 1 et si un numéro n'est pas présent dans la feuille 2, l'inscrire dans la feuille 3.

Comme je le disais ce code fonctionne sauf que parfois, il faut exécuter plusieurs fois la macro afin de recenser l'ensemble des comptes absents. Comme ce classeur est utilisé dans des procédures comptables, c'est quelque peu problématique et l'on risque d'oublier certains comptes.

Je me suis demandé si le problème ne venait pas de cette fonction que j'ai écrit avec un copain :

Function calcMaxRow(une_feuille As String)
'Fonction qui affiche toutes les cellules non vides
Dim y As Integer

y = 11
Do While Sheets(une_feuille).Cells(y, 1) <> ""
y = y + 1
Loop

calcMaxRow = y - 1
End Function


le code de la procédure est celui ci :

Sub ComparaisonBalanceN_1()
Worksheets("comparaisonBalanceN-1").Activate
Dim cellule_2008 As Range
Dim y_comparaison As Integer
Dim range_2007, range_2008 As String

range_2008 = "A11:A" & calcMaxRow("BalanceN-1")
range_2007 = "A11:A" & calcMaxRow("BalanceN")

y_comparaison = 5
For Each cellule_2008 In Worksheets("BalanceN").Range(range_2008)
If Worksheets("balanceN-1").Range(range_2007).Find(cellule_2008.Value, LookIn:=xlValues) Is Nothing Then
Worksheets("ComparaisonBalanceN-1").Cells(y_comparaison, 1).Value = cellule_2008.Value
Worksheets("ComparaisonBalanceN-1").Cells(y_comparaison, 2).Value = cellule_2008.Offset(, 1).Value
y_comparaison = y_comparaison + 1
End If
Next cellule_2008
End Sub


J'ai voulu le modifier comme suit (ligne de couleur rouge) mais à l'exécution rien ne se passe :

Sub comparaisonBalance()
Worksheets("comparaisonBalN").Activate
Dim cellule_2007 As Range
Dim y_comparaison As Integer
Dim range_2007, range_2008 As String

range_2007 = "A11:A" & Sheets("balanceN-1").Range("A65536").End(xlUp).Row
range_2008 = "A11:A" & Sheets("balanceN").Range("A65536").End(xlUp).Row

y_comparaison = 5
' test permettant ce copier dans la feuille spécifié les n° de comptes manquants
' et les intitulés de comptes
For Each cellule_2007 In Worksheets("BalanceN-1").Range(range_2007)
If Worksheets("balanceN").Range(range_2008).Find(cellule_2007.Value, LookIn:=xlValues) Is Nothing Then
' copie les n° de comptes manquants
Worksheets("ComparaisonBalN").Cells(y_comparaison, 1).Value = cellule_2007.Value
' copie les intitulés des numéros de cptes manqunts avec la propiriété offset
Worksheets("ComparaisonBalN").Cells(y_comparaison, 2).Value = cellule_2007.Offset(, 1).Value
y_comparaison = y_comparaison + 1
End If
Next cellule_2007
End Sub


Les noms de feuilles diffèrent entre la procédure 1 et la procédure 2 car ce sont des procédures qui traitent respectivement la feuille 1 et la feuille 2.

J'espère avoir été assez clair et remercie la personne qui voudra me donner un peu d'aide.
 

Statistiques des forums

Discussions
312 329
Messages
2 087 334
Membres
103 519
dernier inscrit
Thomas_grc11