Macro Excel : Comparaison de 2 feuilles

Version imprimable

"Bonjour"

Voilà, je souhaite faire une macro Excel me permettant de comparer 2 onglets excel d'une semaine d'écart (2 exports de ma base clients) et m'affiche les nouveaux clients dans un 3ème onglet.
Je précise que je suis débutant en VB.

En cherchant sur le net et en bricolant un peu, voila ce que j'ai fait :
Code:

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 //MACRO DELTA Sub delta() Classeur = Application.GetOpenFilename("Classeurs Excel,*.xls") If Classeur = False Then Exit Sub Workbooks.Open Filename:=Classeur Windows("Classeur1.xls").Activate Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, i1, i2, i3, k, kk Set ws1 = Worksheets(1) Set ws2 = Worksheets(2) i1 = ws1.Range("A1").End(4).Row i2 = ws2.Range("A1").End(4).Row Sheets.Add After:=Sheets(Worksheets.Count) Set ws3 = Worksheets(3) i3 = 0 With ws1 For k = 1 To i1 mat1 = .Range("A" & k) For kk = 1 To i2 mat2 = ws2.Range("A" & kk) z2 = ws2.Range("A" & kk).Columns If mat2 <> mat1 Then ws3.Range("A" & i3 + 1) = z2 i3 = i3 + 1 End If Next Next End With End Sub
Mes valeurs de tests sont (chq valeur est sur une ligne différente) :
Feuille 1 : toto tata titi
Feuille 2 : toto tutu tete

Le résultat que j'obtiens :
Feuille 3 : tutu tete toto tutu tete toto tutu tete

Le résultat que je voudrais obtenir :
Feuille 3 : tutu tete

En gros, l'algorithme que je cherche à mettre en place est :

Citation:

Pour chaque client c dans Feuille 2
si c est dans Feuille 1
alors rien
sinon
copier c dans Feuille 3

Merci pour votre aide

Edit

Code:

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
Sub Delta()
Dim wbk As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim Classeur As Variant
Dim LastLig1 As Long, LastLig2 As Long, i As Long
Dim c As Range
 
Application.ScreenUpdating = False
Classeur = Application.GetOpenFilename("Classeurs Excel,*.xls")
If Classeur <> False Then
    Set wbk = Workbooks.Open(Classeur)
    Set ws1 = wbk.Worksheets(1)
    Set ws2 = wbk.Worksheets(2)
    LastLig1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    LastLig2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
 
    Set ws3 = wbk.Sheets.Add(After:=wbk.Sheets(Worksheets.Count))
    For i = 1 To LastLig2
        Set c = ws1.Range("A1:A" & LastLig1).Find(ws2.Range("A" & i).Value, lookat:=xlWhole)
        If c Is Nothing Then ws2.Range("A" & i).Copy ws3.Cells(Rows.Count, 1).End(xlUp)(2)
    Next i
    Set ws3 = Nothing
    Set ws2 = Nothing
    Set ws1 = Nothing
    wbk.Save
    wbk.Close
    Set wbk = Nothing
End If
End Sub

19/10/2010, 16h32
michaeljeru

Mercatog, tu reprends une fonction la fonction Find que j'ai déjà trouvée auparavant, sans réussir à la faire fonctionner. Donc ça devrait me plaire.

Par contre, il y a un message d'erreur incompréhensible sur la ligne : "If c is nothing Then c.copy(...)"

Citation:

Erreur d'exécution '91' :

Variable objet ou variable de bloc With non définie
19/10/2010, 16h37
mercatog

J'ai édité ma réponse. désolé
19/10/2010, 16h57
michaeljeru

Ok, merci, ça marche. J'ai juste la première cellule qui est vide, je ne sais pas pourquoi.

j'essaye d'aller plus loin maintenant, et de récupérer non pas la seule 1ère colonne, mais les lignes entières concernées.

j'ai donc modifié la ligne

Code:

If c Is Nothing Then ws2.Range("A1:E" & i).Copy ws3.Cells(Rows.Count, 1).End(xlUp)(2)

afin d'atteindre jusqu'à la colonne E

Mais j'obtient un résultat inexact :

Citation:

(toujours une ligne vide)
toto 1 2 3 4
tutu 2 3 4 5
toto 1 2 3 4
tutu 2 3 4 5
tete 3 4 5 6

au lieu de

Citation:

tutu 2 3 4 5
tete 3 4 5 6

Edit: Si tu as des doublons sur la feuille 2

Code:

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
Sub Delta()
Dim wbk As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim Classeur As Variant
Dim LastLig1 As Long, LastLig2 As Long, i As Long, k As Long
Dim c As Range, v As Range
 
Application.ScreenUpdating = False
Classeur = Application.GetOpenFilename("Classeurs Excel,*.xls")
If Classeur <> False Then
    Set wbk = Workbooks.Open(Classeur)
    Set ws1 = wbk.Worksheets(1)
    Set ws2 = wbk.Worksheets(2)
    LastLig1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    LastLig2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
 
    Set ws3 = wbk.Worksheets.Add(After:=wbk.Sheets(wbk.Worksheets.Count))
    For i = 1 To LastLig2
        Set c = ws1.Range("A1:A" & LastLig1).Find(ws2.Range("A" & i).Value, lookat:=xlWhole)
        If c Is Nothing Then
        Set v = ws3.Columns(1).Find(ws2.Range("A" & i).Value, lookat:=xlWhole)
        If v Is Nothing Then
            k = k + 1
            ws2.Range("A" & i & ":E" & i).Copy ws3.Range("A" & k)
            End If
        End If
        Set v = Nothing
    Next i
    Set c = Nothing
    Set ws3 = Nothing
    Set ws2 = Nothing
    Set ws1 = Nothing
    wbk.Save
    wbk.Close
    Set wbk = Nothing
End If
End Sub