[XL-2003] Comparaison de 2 colonnes avec copie d'éléments

[Shinmey]

Bonjour à tous !

Je suis tout nouveau sur ce forum, je débute en programmation VBA et je me suis déjà bien aidé des questions diverses qui ont été posées dessus pour mes macros mais la je bloque.

Je dois créer une macro qui compare deux colonnes de 2 feuilles différentes.

Si une valeur est identique dans les 2 colonnes, alors le reste de la ligne de la première feuille doit être copié sur la ligne correspondante dans la 2eme feuille.

Si une valeur de la 1ere feuille n'existe pas dans la 2eme feuille, alors la ligne correspondante doit être copié à la fin du tableau de la 2eme feuille.

En gros j'ai 2 tableau, un avec des données brutes, sans mise en page, dans une ordre quelconque, et dans la 2eme une joli feuille par ordre alphabétique avec une mise en page avec filtre & Co, et donc quand j'ai de nouvelles données elles sont copiées/collées de but en blanc dans ma première page, et ma macro doit mettre à jour la 2eme feuille avec la mise à jour des anciennes lignes/données et rajouter une nouvelles lignes si on a de nouvelles entrées.

J'ai donc fait ceci :

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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Sub MàJ_Export()
 
 
'Déclaration de variables
Dim i As Integer
Dim j As Integer
Dim Ligne As Long
 
Ligne = (Range("B1").End(xlDown).Row + 1)
i = 2
j = 7
 
' Activation feuille source Bo
 
Sheets("source BO").Activate
 
' On fait une boucle tant qu'une case de la colonne E de la feuille Bo n'est pas vide
Do Until Worksheets("source BO").Cells(i, 5) = ""
Do Until Worksheets("Export").Cells(j, 6) = ""
' Si On a une egalité entre le SAP de la 1ere ligne de feuille BO et de la feuile Export
   If Worksheets("source BO").Cells(i, 5).Value = Worksheets("Export").Cells(j, 6).Value Then
   ' On selectionne les case à droite de la case SAP de la feuille Bo
   Sheets("source BO").Select
   Union(Cells(i, 6), Cells(i, 7), Cells(i, 8), Cells(i, 9), Cells(i, 10), Cells(i, 11), Cells(i, 12), Cells(i, 13), Cells(i, 14), Cells(i, 15), Cells(i, 16), Cells(i, 17), Cells(i, 18), Cells(i, 19)).Select
   ' On copie la selection
   Selection.Copy
   ' On selectionne la feuille export
   Sheets("Export").Select
   ' On sélectionne l'endroit ou copier et copie
   Cells(j, 7).Select
   ActiveSheet.Paste
   Sheets("source BO").Select
 
   i = i + 1
   j = 7
   Else
   ' Si pas d'égalité On change de ligne de la feuille Export à comparer
   j = j + 1
   End If
   ' On change de ligne de la feuille BO à comparer
 
Loop
 
' Si on est pas rentré dans le if, c'est qu'on a jamais trouvé d'égalité donc on copie à la fin du tableau la ligne complète
Sheets("source BO").Select
Union(Cells(i, 1), Cells(i, 2), Cells(i, 3), Cells(i, 4), Cells(i, 5), Cells(i, 6), Cells(i, 7), Cells(i, 8), Cells(i, 9), Cells(i, 10), Cells(i, 11), Cells(i, 12), Cells(i, 13), Cells(i, 14), Cells(i, 15), Cells(i, 16), Cells(i, 17), Cells(i, 18), Cells(i, 19)).Select
Selection.Copy
Sheets("Export").Select
Range("B" & Ligne).Select
ActiveSheet.Paste
 
' On incrémente nos variable pour continuer
i = i + 1
j = 7
 
 
Loop
 
 
End Sub

La MàJ des données marche, quand j'ai 2 cellules identiques des colonnes, la MàJ se fait bien, par contre pour ce qui est de l'ajout d'un nouvelle ligne quand on a de nouvelles données ça coince ...

Je me doute qu'il manque quelque chose mais je n'arrive pas à voir où ...

Si vous voyez et voulez/pouvez bien m'aider ...
C'est seulement la 2eme macro que je crée tout seul ( ou presque ) donc soyez indulgents si c'est brouillon ^^'

Merci à vous, en espérant une réponse (rapide?)

Bonne journée, Amicalement, Shinmey.

[Sclarckone]

La structure de ta procédure me parait bonne...essaie de remplacer:

Code :

1
2
3
4
5
6
7
' Si on est pas rentré dans le if, c'est qu'on a jamais trouvé d'égalité donc on copie à la fin du tableau la ligne complète
Sheets("source BO").Select
Union(Cells(i, 1), Cells(i, 2), Cells(i, 3), Cells(i, 4), Cells(i, 5), Cells(i, 6), Cells(i, 7), Cells(i, 8), Cells(i, 9), Cells(i, 10), Cells(i, 11), Cells(i, 12), Cells(i, 13), Cells(i, 14), Cells(i, 15), Cells(i, 16), Cells(i, 17), Cells(i, 18), Cells(i, 19)).Select
Selection.Copy
Sheets("Export").Select
Range("B" & Ligne).Select
ActiveSheet.Paste

par quelque chose de moins compliqué, genre ceci:

Code :

1
2
 
Sheets("source BO").Range(Cells(i, 1), Cells(i, 19)).Copy(Sheets("Export").Cells(Ligne, 2))

[Shinmey]

Bonjour Sclarckone, merci de ta réponse.

J'ai remplacé par ton texte plus simple, et malheureusement j'ai toujours la même chose.
Dans ma feuille où je colle, j'ai toujours la dernière ligne de ma feuille où je copie qui est copiée à la fin, même si elle est déjà existante, mais si j'ai des lignes manquantes dans le milieu du tableau elle ne sont pas copiées ...

Je ne comprend toujours pas donc :/

Je joins mon fichier, si jamais quelqu'un a l'inspiration, ou trouve l'erreur ...

Au pire je vais essayer de coloriser les cases qui ont été copiées/collées comme ça on pourra voir ce qui a été mis à jour et ce qui manque pour finir à la main, mais c'est dommage de devoir en arriver là :/

[Sclarckone]

En fait il y a une erreur pour déterminer la première ligne libre. Il y a un "trou" dans ton tableau et du coup le code:

Code :

Ligne = (Range("B1").End(xlDown).Row + 1)

désigne une ligne qui n'est pas vide (et apparemment ça dérange la méthode Range.Copy()).

Remplace donc cette ligne par ça:

Code :

Ligne = (Range("B65536").End(xlUp).Row + 1)

et ça devrait fonctionner!

[Shinmey]

J'avais remarqué ça, c'est pourquoi j'avais mis des points puis des espaces dans les cases du dessus.

Enfin il n'empêche que j'ai essayé et ça ne change rien ...

Mais ce n'est pas grave, j'ai fais autrement, comme les nouvelles données sont peu nombreuses, j'ai fais coloré les cases qui ont été mises à jour pour les repérer plus rapidement et pour que l'on puisse finir à la main rapidement.

Merci en tout vas de vos réponses, même si malheureusement pas de vraies solution trouvées, j'ai pu me débrouiller =)

Bonne fin et journée et à bientôt !