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 :
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
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 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
Merci beaucoup et bonne soirée !
Axel
Partager