[XL-2003] Comparer deux feuilles et copier les valeurs équivalentes sur une troisième

[Julzz]

Bonjour à tous,

J’essaie d'écrire une macro qui me comparerait les valeur de la feuille 1 avec celles de la feuille 2 et lorsqu'il y aurait la même valeur sur les feuilles 1 et 2 couperait la ligne entière sur la feuille 1 et la collerait dans la feuille 3.

J'ai écris le code suivant :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
Dim m As Integer
Dim n As Integer
Dim reponse As Boolean
 
    For m = Sheets("Feuille 1").Range("A65000").End(xlUp).Row To 10 Step -1
        reponse = True
 
       For n = Sheets("Feuille 2").Range("A65000").End(xlUp).Row To 1 Step -1
 
            If Sheets("Feuille 1").Range("A" & m).Value = Sheets("Feuille 2").Range("A" & n).Value Then reponse = False
 
       Next n
                If reponse = True Then
                Sheets("Feuille 1").Rows(m).EntireRow.Select 
                Selection.Cut
                Sheets("Feuille 3").Select
                Range("A10").Select
                ActiveSheet.Paste
                End If
 
    Next m

La macro semble faire son boulot jusqu'à trouver deux valeur équivalente, à ce moment là elle plante et s'affiche une erreur 1004 : "La méthode sélect de la classe range a échouée"...

qu'en pensez vous ?

[Duddy]

Bonjour le forum,

J'aurais plutôt écris :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Dim m As Integer
Dim n As Integer
dim vDerligne as Integer
Dim reponse As Boolean
 
    For m = Sheets("Feuille 1").Range("A65000").End(xlUp).Row To 10 Step -1
        reponse = False
 
       For n = Sheets("Feuille 2").Range("A65000").End(xlUp).Row To 1 Step -1
 
            If Sheets("Feuille 1").Range("A" & m).Value = Sheets("Feuille 2").Range("A" & n).Value Then reponse = True
 
       Next n
                If reponse = True Then
                Sheets("Feuille 1").Rows(m).EntireRow.Select 
                Selection.Cut
                Sheets("Feuille 3").Select
vDerligne= Sheets("Feuille 3").Range("A65000").End(xlUp).Row               
Range("A" & vDerligne).Select
                ActiveSheet.Paste
                End If
 
    Next m

En espérant avoir compris ta demande.