VBA-comparer deux fichiers excel sur une colonne et ajouter des lignes d'un fichier vers l'autre

Version imprimable

Bonsoir,

Je viens vers vous pour un problème en VBA. J'ai deux fichiers contenant chacun une base de données d'équipement : le premier document A est mon doc excel référent, le second doc B est un doc excel extrait d'un logiciel qui me sert a mettre a jour le doc référent A.

Mon but est de comparer une colonne (référence équipement) pour que les produits du doc B qui ne sont pas sur mon doc A soient copiés à la suite.

J'ai donc fait 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
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Sub MAJequipement()
'decla variables
Dim wbmaj As Workbook 'fichier mis a jour
Dim wba As Workbook 'fichier que je souhaite mettre a jour
Dim wsmaj As Worksheet 'feuille du fichier a jour
Dim wsa As Worksheet 'feuille du fichier a mettre a jour
Dim c As Range 'cellule parcourant le fichier a jour
Dim tr As Range 'cellule parcourant le fichier a mettre a jour
Dim PLR As Range 'plage référente feuille mise a jour
Dim PLS As Range 'plage du fichier a mettre a jour
Dim derl As Long 'derniere ligne de la feuille a mettre a jour
 
'affiliation des variables fichiers excel et ouverture des fichiers
Application.Workbooks.Open ("C:\Users\axel.loiacono\Desktop\Axel.xlsx")
Application.Workbooks.Open ("C:\Users\axel.loiacono\Desktop\Axel2.xlsx")
Set wbmaj = Workbooks("Axel2.xlsx")
Set wba = Workbooks("Axel.xlsx")
 
'nouvelles données colonne A pour effectuer MAJ
Set wsmaj = wbmaj.Worksheets(1)
Set PLR = wsmaj.Columns(1)
 
'données colonne A actuelles
Set wsa = wba.Worksheets(1)
Set PLS = wsa.Columns(1)
 
With PLR
    For Each c In PLR
        Set tr = PLS.Cells.Find(c.Value)
        If tr Is Nothing Then
        Windows("Axel2.xlsx").Activate
        PLR.c.EntireRow.Copy
        Windows("Axel.xlsx").Activate
        derl = PLS.End(xlUp).Row + 1 'je met la variable derl ici pour la redefinir a chaque boucle
        Cells(derl, 1).Select
        ActiveSheet.Paste
        End If
    Next c
End With
End Sub

Aucun bug mais rien ne marche, je m’emmêle avec les activations de documents etc ... il doit y avoir une énormité niveau logique et j'ai besoin d'un regard neuf

Merci beaucoup et bonne soirée !

Axel

04/05/2017, 22h52
patricktoulon

re

bonsoir
si je comprends bien
tu ouvre 2 classeurs pour récupérer une colonne dans chaque jusqu'à la dernière ligne utilisée

et dans le classeur contenant la macro tu met les 2 colonnes en une sans doublons
c'est bien ca ?
dans ce cas la tu fait beaucoup de mouvement pour rien
dim 2 variables tableau ou une avec 2i
tem pour sous tableau

dim tablo(2)
open classeur 1 puis tablo(0)= range(xy:az).value , ferme classeur 1
open classeur 2 puis tablo(1)= range(xy:az).value , ferme classeur 2
et dans une double boucle sur les 2 tablo et leur item tu alimente ta colonne sur le classeur.sheet de reception
moins de 10 ligne est nécessaire pour faire cela
04/05/2017, 23h05
axel.loiacono

Alors en fait j'ai deux fichiers excel contenant deux tableaux, de la même forme. Seulement un fichier est extrait de manière hebdomadaire sur le site de ma boite et doit venir mettre à jour un autre classeur sur lequel est construit pleins de choses (indicateurs ect).

La mise à jour parait simple : il faut que ce qui n'est pas dans le tableau extrait rentre dans le tableau de mon doc excel utile

En gros si je passe par les tableaux, je devrais faire deux tableaux 1(fichier1) et tableau2(fichier2) , parcourir les valeurs du tableau 2 et si une valeur n'est pas présente dans le tableau 1, ajouter la ligne correspondant dans le fichier 1, mais je ne vois pas comment faire la boucle, avec les ouvertures / fermetures de fichier ...
05/05/2017, 09h40
halaster08

Bonjour,

Ca peut se faire simplement avec un filtre avancé (tuto:http://philippetulliez.developpez.co...dvancedfilter/)
Avec un critère calculé qui vérifie la non présence de l'identifiant du fichier 2 dans le fichier 1

Merci pour vos conseils, j'ai réussi finalement sans filtre, mais je vais essayer de le faire avec pour m'entrainer, voici le code fonctionnel:

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
Sub MAJ()
Dim WBB As Workbook 'fichier servant pour la mise a jour
Dim WBA As Workbook 'fichier à mettre à jour
Dim wsb As Worksheet
Dim wsa As Worksheet
Dim c As Range
Dim derlig3 As Long
Dim derlig, derlig2 As Long
Dim nolig As Long
Dim tablo As Variant
 
Application.ScreenUpdating = False
 
'indexation des fichiers et des feuilles
Set WBB = Workbooks("axel2.xlsx")
Set WBA = Workbooks("axel.xlsx")
Set wsb = WBB.Worksheets("feuil1")
Set wsa = WBA.Worksheets("feuil1")
 
'derniere ligne plage de donnéeWBB.wsb.Activate
derlig = wsb.Range("A1").End(xlDown).Row
derlig2 = wsa.Range("A1").End(xlDown).Row
 
' création tableau
tablo = wsb.Range("A1:A" & derlig).Value
 
'Parcours du tableau wsb et recherche wsa
With wsa.Range("A1:A" & derlig2)
    For nolig = 1 To derlig
        Set c = .Find(tablo(nolig, 1))
        If c Is Nothing Then
        derlig3 = wsa.Range("A1").End(xlDown).Row
        wsb.Cells(nolig, 1).EntireRow.Copy wsa.Range("A" & derlig3 + 1)
        End If
    Next
End With
 
End Sub

je me suis aidé du très bon tutoriel : https://www.developpez.net/forums/d7...au-dimensions/

que j'ai adapté à mes souhaits !

07/05/2017, 16h26
Marc-L

Bonjour,

~ dix lignes de code via un filtre avancé …

___________________________________________________________________________________________________________
Je suis Paris, Egypte, Stockholm, London, Istanbul, Berlin, Nice, Bruxelles, Charlie, …