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 : 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 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
Partager