Macro - Maj suivi depuis un fichier excel

**Piros31** · 28/04/2017, 14h38

Bonjour,
Je viens ici en dernier recours

...
Je tente de m'approprier une macro pour mettre à jour un fichier de suivi depuis un fichier source qui évolue dans le temps.
J'y suis parvenu en parti mais c'est completement satisfaisant.
je veux que ma macro enrichisse mon fichier de suivi si la colonne AF de mon source est renseigné (si oui, elle me copie un certain nombre de cellule de la meme ligne) => ça, ça marche alleluia !

Mon problème c'est qu'elle me copie qu'une seule ligne par recherche.
exemple :
la colonne AF peut contenir plusieurs fois "1", si c'est le cas je n'aurais que les informations du premier "1", je voudrais que cela copie l'ensemble des lignes contenant "1" en mettant en condition la colonne "K".
Soit :
Si AF non trouvé dans cible => copier les éléments
Si AF trouvé dans cible mais "K" différent => copier aussi les éléments.
J'espere que quelqu'un aura compris mon javanais

et merci par avance aux personnes qui pourront me filer un coup de main.

Voici la macro en l'état actuelle des choses :

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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
Sub MAJ_SUIVI_VIA_FICHIER_CLIENT() 
Dim Path_name As String 
Dim File_name As String 
Dim Complete_File_name As String 
 
'désactive la mise à jour de l'affichage 
Application.ScreenUpdating = False 
 
Sheets("Suivi Dépl new model V1").Select 
 
'construit une date pour le nom du fichier d'écart 
LaDate = Date 
LeTableauDate = Split(Date, "/") 
LaDate = LeTableauDate(0) & LeTableauDate(1) & LeTableauDate(2) 
 
Path_name = ThisWorkbook.Path 
LeFichierClient = Path_name & "\" & "Suivi des déploiements 2017.xlsm" 
'LeFichierEcart = Path_name & "\" & "SUIVI_CMO_" & LaDate & ".xlsx" 
 
'défini le nom du fichier de suivi (versionning) 
LeNomFichierSuivi = ActiveWorkbook.Name 
 
'ouvre le fichier client 
Workbooks.Open Filename:=LeFichierClient 
 
 
 
 
 'Sélectionne le fichier du client 
 Windows("Suivi des déploiements 2017.xlsm").Activate 
 
' Selectionne la première cellule de la colonne "AF=BdC UO" 
Range("A2").Select 
''intialise le compteur d'écart à 1 pour prendre en compte la ligne de titre 
'CompteurEcart = 2 
 
 ' Boucle tant que pas vide 
 Do While Not (IsEmpty(ActiveCell)) 
 
' 'sélectionne le fichier de suivi 
' Windows(LeNomFichierSuivi).Activate 
 
 'lecture de la valeur du BDCU 
 Debug.Print Cells(ActiveCell.Row, 32).Value 
 LaValeurBDCU = Cells(ActiveCell.Row, 32).Value 
 LaValeurPERIMETRE = Cells(ActiveCell.Row, 34).Value 
 Debug.Print "Le périmètre est " & LaValeurPERIMETRE 
 
If LaValeurPERIMETRE = "CC" Then 
 
' 'Sélectionne le fichier du client 
' Windows("Suivi des déploiements 2017.xlsm").Activate 
 'active le fichier de suivi 
 Windows(LeNomFichierSuivi).Activate 
 
 'lance la recherche de la valeur dans la colonne "AF" 
 Range("N1").Select 
 Columns("N:N").Select 
 
 Set LaRecherche = Columns("N:N").Find(What:=LaValeurBDCU, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ 
 True, SearchFormat:=False) 
 
 If LaRecherche Is Nothing Then 'test si la recherche à donné un résultat 
 'pas trouvé 
 'alors nous ajoutont la ligne dans le fichier de suivi 
 Debug.Print "ajout de ligne dans suivi" 
 'CompteurEcart = CompteurEcart + 1 
 'Sélectionne le fichier du client 
 Windows("Suivi des déploiements 2017.xlsm").Activate 
 
 'Lire les champs A,D,P,N,G,H,I,S 
 'normalement la cellule active est dans la colonne G 
 LaLigneEnCours = ActiveCell.Row 
 CLIENT_Type_OP = Range("A" & LaLigneEnCours).Value 
 CLIENT_RNE = Range("D" & LaLigneEnCours).Value 
 CLIENT_Tranche = Range("P" & LaLigneEnCours).Value 
 CLIENT_Type_équipement = Range("J" & LaLigneEnCours).Value 
 CLIENT_Mois_souhaité_de_déploiement = Range("N" & LaLigneEnCours).Value 
 CLIENT_Nom = Range("G" & LaLigneEnCours).Value 
 CLIENT_VILLE = Range("H" & LaLigneEnCours).Value 
 CLIENT_DPT = Range("I" & LaLigneEnCours).Value 
 CLIENT_Qte = Range("L" & LaLigneEnCours).Value 
 CLIENT_Nature = Range("K" & LaLigneEnCours).Value 
 CLIENT_reseau = Range("M" & LaLigneEnCours).Value 
 CLIENT_NUM_BdC_MAT = Range("S" & LaLigneEnCours).Value 
 CLIENT_BDCUO = LaValeurBDCU 
 'active le fichier de suivi 
 Windows(LeNomFichierSuivi).Activate 
 
 'insert une nouvelle ligne dans le fichier de suivi 
 Rows("3:3").Select 
 Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
 
 'sélectionne la ligne active 
 LaLigneActive = ActiveCell.Row 
 
 'met à jour les valeurs puis met en jaune les modifications 
 Range("A" & LaLigneActive).Value = CLIENT_Type_OP 
 Range("B" & LaLigneActive).Value = CLIENT_RNE 
 Range("C" & LaLigneActive).Value = CLIENT_Tranche 
 Range("D" & LaLigneActive).Value = CLIENT_Mois_souhaité_de_déploiement 
 Range("E" & LaLigneActive).Value = CLIENT_Nom 
 Range("F" & LaLigneActive).Value = CLIENT_VILLE 
 Range("G" & LaLigneActive).Value = CLIENT_DPT 
 Range("H" & LaLigneActive).Value = CLIENT_NUM_BdC_MAT 
 Range("I" & LaLigneActive).Value = CLIENT_Type_équipement 
 Range("J" & LaLigneActive).Value = CLIENT_Nature 
 Range("K" & LaLigneActive).Value = CLIENT_Qte 
 Range("L" & LaLigneActive).Value = CLIENT_reseau 
 Range("N" & LaLigneActive).Value = CLIENT_BDCUO 
 
 'sélectionne la ligne 
 Range("A" & LaLigneActive & ":" & "G" & LaLigneEnCours).Select 
 
 'met en jaune 
 With Selection.Interior 
 .Pattern = xlSolid 
 .PatternColorIndex = xlAutomatic 
 .Color = 65535 
 .TintAndShade = 0 
 .PatternTintAndShade = 0 
 End With 
 'réinitialise la variable 
 LaLigneEnCours = "" 
 LaLigneActive = "" 
 
 
 
 Else 
 'trouvé 
 Debug.Print "trouvé donc pas d'ajout de ligne" 
 
 
 End If 
 
End If ' LaValeurPERIMETRE = "CC" 
 'Sélectionne le fichier du client 
 Windows("Suivi des déploiements 2017.xlsm").Activate 
 
 ' Passe à la ligne suivante 
 Selection.Offset(1, 0).Select 
 Loop 
 
''sauvegarde le fichier 
'ActiveWorkbook.Save 
'ActiveWorkbook.Close 
 
 
'fermeture du fichier client sans enregistrer 
Windows("Suivi des déploiements 2017.xlsm").Activate 
ActiveWorkbook.Close False 
 
'active le fichier de suivi 
Windows(LeNomFichierSuivi).Activate 
 
 
 
'active la mise à jour de l'affichage 
Application.ScreenUpdating = True 
 
MsgBox "Mise à jour terminée" 
 
End Sub

**halaster08** · 28/04/2017, 14h50

Bonjour,

Pour plus de lisibilité met ton code entre balise code (bouton #)

la colonne AF peut contenir plusieurs fois "1", si c'est le cas je n'aurais que les informations du premier "1", je voudrais que cela copie l'ensemble des lignes contenant "1" en mettant en condition la colonne "K".

Tu devrais jeter un oeil au filtres avancés: http://philippetulliez.developpez.co...dvancedfilter/

**Piros31** · 28/04/2017, 15h09

Navré - Je viens de faire la modification pour utiliser les balises, c'est effectivement plus claire !

Merci pour le lien, je vais voir ce que je peux y trouver

Envoyé par halaster08

Bonjour,

Pour plus de lisibilité met ton code entre balise code (bouton #)

Tu devrais jeter un oeil au filtres avancés: http://philippetulliez.developpez.co...dvancedfilter/