Bonjour le forum ,

J'ai un problème en VBA Excel (evidemment je débute) et je fais donc appel a vous!!

Je possède 2 feuilles que je dois comparer: une feuille de référence, et une nouvelle feuille. Ceci dans le but de voir les écarts entre les deux feuilles, une sorte de mise a jour! Et les résultats s'affichent dans les feuilles correspondantes.
C'est en fait un inventaire de postes. Et je cherche a savoir quels sont les postes créés, les postes existant mais dont les informations ont changé (changement de propriétaire par exemple), et les postes détruits.
J'ai donc 5 feuilles: Nouveau, Ancien, Crees, Modifies, Supprimes.
Je précise que toutes ces feuilles sont dans le même classeur!

Maintenant je vais tenter de vous expliquer le principe de mon code et ce que je voudrais!
Pour comparer, le programme se base sur un critère de référence commun aux 2 feuilles et unique (aucun doublon possible dans la même colonne). Ce critère commence en A8, et nommé PI! Avec la methode FIND, je cherche les PI de la nouvelle feuille(Nouveau) dans la feuille de référence(Ancien).
Si le PI est inexistant, il est considéré comme postes créés et s'affichera dans la feuille correspondante, a savoir "Crees". Si le PI est commun aux 2 feuilles, il doit comparer la ligne entière, pour voir si les informations sont les mêmes ou pas! Et c'est ici que se trouve mon problème. Vu que les PI ne sont pas forcement a la même position dans les 2 feuilles, je ne peux pas me permettre de faire une comparaison ligne/ligne. Donc je fais une comparaison colonne/colonne dans une ligne dans chacune des feuilles. Mais avec FIND il y a quelque chose qui ne va pas! Si j'ai un doublon dans l'une des colonnes d'informations, il considère que la recherche est positive, et donc arrete la recherche!

Donc c'est ici que vous entrez en jeu .
Dans le cas ou les PI sont identiques dans les 2 feuilles, je voudrais comparer les informations des 2 PI, se trouvant sur une même ligne et afficher la ligne entière s'il y a des différences. Tout ca dans la feuilles "Modifies"

J'espere que j'ai pas trop bafouillé

Voici mon code:

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
Option Explicit
Sub Created_Modified()
 
'Prog: Regarde les nouveaux par rapport a l'ancien.
 
Dim x, y, z As Variant
Dim i, j, k, l, m, n, q As Long
Dim O, P As Range
Dim address1, address2, address3, address4 As String
Dim WsA, WsN, WsC, WsM As Worksheet
Set WsN = Worksheets("Nouveau")
Set WsA = Worksheets("Ancien")
Set WsC = Worksheets("Crees")
Set WsM = Worksheets("Modifies")
 
'Parcours du fichier comparant (nouveau)
'Nombre de lignes limité a 5000
For i = 8 To 15 '2000
    x = WsN.Cells(i, 1)
   ' k = 1
   ' l = -1
   q = 1
   n = 0
    address1 = "Feuil1!" + Cells(i, 1).Address
    'Recherche dans le fichier comparé (ancien)
    With WsA.Cells
        Set O = .Find(x, lookat:=xlWhole)
        If Not O Is Nothing Then
        ' Si EGALE -> compare la ligne entiere pour trouver des differences
            address2 = "Feuil2!" + O.Address
            For j = 2 To 44 'Nombre de colonnes limité a 20
                y = WsN.Cells(i, j).Value
                address3 = "Feuil1!" + Cells(i, j).Address
                ' Recherche des postes modifiés
                With WsA.Cells
                    Set P = .Find(y, lookat:=xlWhole)
                    If Not P Is Nothing Then
                        address4 = "Feuil2!" + P.Address
                    Else
                    ' Copie dans la feuille "Modifies"
                        ' Affichage des postes modifiés
                        WsM.Range("A65536").End(xlUp)(2) = x
                        WsM.Range("A65536").End(xlUp)(2) = y
                        'WsM.Range("A65536").End(xlUp)(2).Offset(l, k) = y
                        'k = k + 1
                        'l = l - 1
                    End If
                End With
            Next j
        Else
        ' Si DIFFERENT -> copie dans la feuille "Crees"
            ' Affichage des nouveaux postes
            For m = 2 To 44
                z = WsN.Cells(i, m).Value
                WsC.Range("A65536").End(xlUp)(2) = x
                WsC.Range("A65536").End(xlUp).Offset(n, q) = z
                q = q + 1
                n = n - 1
            Next m
        End If
    End With
Next i
WsC.Activate
sup_doublons
WsM.Activate
sup_doublons
End Sub
 
Sub sup_doublons()
Dim i As Long
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   ActiveSheet.UsedRange.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo
   For i = [A65000].End(xlUp).Row To 2 Step -1
     If Cells(i, 1) = Cells(i - 1, 1) Then Rows(i).Delete
   Next i
   Application.Calculation = xlCalculationAutomatic
End Sub