Macro - Mise à jour d'un fichier de suivi depuis un fichier sour

Fermé
Piros31 Messages postés 1 Date d'inscription vendredi 28 avril 2017 Statut Membre Dernière intervention 28 avril 2017 - 28 avril 2017 à 12:03
phadeb Messages postés 86 Date d'inscription dimanche 2 avril 2006 Statut Membre Dernière intervention 13 mai 2017 - 7 mai 2017 à 18:39
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 => copié les éléments
Si AF trouvé dans cible mais "K" différent => copié aussi les éléments.
J'espere que quelqu'un aura compris mon javanais :)
Voici la macro en l'état actuelle des choses :
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
A voir également:

1 réponse

phadeb Messages postés 86 Date d'inscription dimanche 2 avril 2006 Statut Membre Dernière intervention 13 mai 2017 21
7 mai 2017 à 18:39
Bonjour,

J'ai un peu de mal à lire le code,

que signifie

' Passe à la ligne suivante
Selection.Offset(1, 0).Select

Est ce les lignes de la feuille de suivi ou de la feuille de recherche ?

En gros, si j'ai bien saisi le fonctionnement de ton code, il faudrait que la fonction de recherche puisse t'envoyer un vecteur de résultats et non un seul résultat.

Ensuite tu fais une boucle qui se répétera le nombre de fois que de résultats trouvés pour écrire des lignes dans le fichier de suivi.

Si ça marche pas, peux tu mettre un exemple concret avec quelques lignes en exemple, le résultat actuel dans une feuille, le résultat voulu dans une autre.

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


--
0