Comparer 2 plages de cellules

[vadius]

Bonjour

J'ai deux tableaux de donnees dans deux sheets distinctes.

Sur une premiere feuille, j ai un tableau (1) de donnees mis a jour periodiquement via une base donnees externe.

Sur une deuxieme feuille, j ai un tableau (2) qui contient certaines lignes du tableau source, mais dont je modifie manuellement certaines valeurs. Je souhaite modifier certaines de ces entrees et creer un tableau (3)combinant les donnees sources ainsi que les donneees modifiees.

Ainsi, la macro parcourt les lignes du premier tableau. Si elle trouve la ligne modifiee dans le tableau (2) , elle copie cette ligne et la colle dans le tableau final (3). Sinon, elle copie la ligne du tableau (1).
Le test pour trouver une ligne modifiee porte sur les 4 premieres cellules de chaque ligne (qui resteront identiques). L idee est juste de tester la presence de la ligne dans le tableau (2).

La difficulte reside dans la definition des plages de cellules, et de la comparaison des valeurs deux a deux.

Ci dessous mon code :

Pour aider a comprendre:
tableau(1)=Worksheets("Index_Div_Source")
tableau(2)=Worksheets("Index_Div_Manual")
tableau(3)=Worksheets("Index_Div_Final")

J'espere que j ai ete assez clair.. Merci pour votre aide.

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
38
39
40
41
42
43
44
Sub Compare()
 
Dim i As Integer
Dim manualcel As Range
Dim sourcecel As Range
 
Dim lastrow As Integer
 
Application.ScreenUpdating = False
 
lastrow = Worksheets("Index_Div_Source").Range("A65536").End(xlUp).Row
 
 
With Worksheets("Index_Div_Final")
 
For i = 3 To lastrow
 
Set manualcel = Worksheets("Index_Div_Manual").Range("A" & i, "D" & i)
 
For Each sourcecel In Worksheets("Index_Div_Source").Range("A" & i, "D" & i)
 
If sourcecel.Value = manualcel.Value Then
 
Worksheets("Index_Div_Manual").Range("A" & i).EntireRow.Copy
Worksheets("Index_Div_Final").Range("A" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
Else
 
Worksheets("Index_Div_Source").Range("A" & i).EntireRow.Copy
Worksheets("Index_Div_Final").Range("A" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
 
End If
 
Next
 
Application.ScreenUpdating = True
 
Next
 
End With
 
 
End Sub