Appliquer filtre sur fichier unique, puis copier coller le résultat
Donc, je récapitule ce que j'en ai compris :
Dans la feuille "BI 2018" ou autre il faut chercher le code projet qui est par exemple "0004_VRPOM" mais là, je ne vois absolument dans dans quelle feuille et quelle colonne chercher
Par rapport au code que j'ai donné, la plage n'est plus à rechercher sur toute la feuille de BDD (puisqu'il y a des colonnes contenant des formules qu'il ne faut absolument pas toucher comme par exemple dans la feuille "BI 2018") mais seulement des colonnes de A à U (si j'ai bien compris !) seulement, ce que je ne comprend pas, c'est qu'il n'y a aucune correspondance de champs entre la base de données et la feuille "BI 2018" par exemple ???
Bon, à ce stade, j'attend une explication précise de la procédure à mettre en place c'est à dire "prendre les valeurs de la colonne ? à la colonne ? par rapport à la valeur ? située dans la colonne ? de la BDD et les coller dans la feuille ? qui correspond à la feuille ? du fichier "P204-0004_VRPOM.xlsm", une fois que j'aurai bien cerné la demande, il sera facile de mettre en place une boucle sur les fichiers puis les feuilles de chacun d'eux afin de rapatrier les valeurs.
Theze ... tu me sauverais car là je n'ai vraiment pas beaucoup de temps (du reste toi non plus, c'est pour cela qu'il vaut mieux que les sujets soient bien lancés dès la demande).
Désolé, j'ai voulu simplifier la demande en enlevant des éléments qui pouvaient être perturbant, mais je n'aurai pas du.
Du coup je fournis en pièce jointe la vrai base de donnée, allégée en nombre de ligne pour qu'elle ne dépasse pas la taille maximale, puis j'explique au pas à pas les manipulations.
Objectif 1:
mise à jour du fichiers "P204-0004_VRPOM" / onglet "BI 2018":
- se positionner sur le fichier "P204-0004_VRPOM" / onglet "BI 2018", copier la valeur de la colonne "N" (cellule N1 par exemple)
- coller cette valeur dans le fichier "BDD" / onglet "BI 2018" / dans le filtre de la colonne N (on obtient que les données du projet P204-0004)
- sélectionner, puis copier la plage obtenu de A à U
- Coller ces données dans le fichier "P204-0004_VRPOM", dans l'onglet "BI 2018" en cellule A1
- -> L'onglet BI 2018 est à jour
Objectif 2:
mise à jour du fichiers "P204-0004_VRPOM" / onglet "CJIA 2018":
- se positionner sur le fichier "P204-0004_VRPOM" / onglet "CJIA 2018", copier la valeur de la colonne "B" (cellule B1 par exemple)
- coller cette valeur dans le fichier "BDD" / onglet "CJIA 2018" / dans le filtre de la colonne B (on obtient que les données du projet P204-0004)
- sélectionner, puis copier la plage obtenu de A à W
- Coller ces données dans le fichier "P204-0004_VRPOM", dans l'onglet "CJIA 2018" en cellule A1
- -> l'onglet "CJIA 2018" est à jour
Objectif 3:
mise à jour du fichiers "P204-0004_VRPOM" / onglet "CJI3 2018":
- se positionner sur le fichier "P204-0004_VRPOM" / onglet "CJI3 2018", copier la valeur de la colonne "T" (cellule T1 par exemple)
- coller cette valeur dans le fichier "BDD" / onglet "CJI3 2018" / dans le filtre de la colonne T (on obtient que les données du projet P204-0004)
- sélectionner, puis copier la plage obtenu de A à AF
- Coller ces données dans le fichier "P204-0004_VRPOM", dans l'onglet "CJI3 2018" en cellule A1
- -> l'onglet "CJI3 2018" est à jour
J'aurai la même chose à faire pour le BI 2019 / CJIA 2019 / CJI3 2019 mais je n'ai pas encore créé les onglets, et je pense être capable d'adapter le code
J'espère que le pas à pas est assez clair cette fois-ci.
Merci encore!
Bonjour,
A tester mais le code est fait pour les fichiers présentés. Les valeurs à rechercher ne sont pas en ligne 1 (entêtes de colonnes) mais ligne 2. Petite précision, la copie d'un filtre embarque d'office les entêtes de colonnes. C'est la Sub "Test" qu'il faut exécuter, cette dernière appelle la Sub "Filtrage" de façon successive en passant les arguments nécessaires. Attention tout de même, les deux classeur doivent être ouverts :
Sub Test()
Dim ClBDD As Workbook
Dim ClVRPOM As Workbook
Dim NomFe As String
Set ClBDD = Workbooks("BDD.xlsx")
Set ClVRPOM = Workbooks("P204-0004_VRPOM.xlsm")
NomFe = "BI 2018"
Filtrage ClBDD, ClVRPOM, NomFe, ClVRPOM.Worksheets(NomFe).Range("N2").Value, 21, 14, "A:U"
NomFe = "CJIA 2018"
Filtrage ClBDD, ClVRPOM, NomFe, ClVRPOM.Worksheets(NomFe).Range("B2").Value, 23, 2, "A:W"
NomFe = "CJI3 2018"
Filtrage ClBDD, ClVRPOM, NomFe, ClVRPOM.Worksheets(NomFe).Range("T2").Value, 32, 20, "A:AF"
End Sub
Sub Filtrage(ClBDD As Workbook, _
ClVRPOM As Workbook, _
Feuille As String, _
Critere As String, _
Col As Integer, _
Champ As Integer, _
PlgCol As String)
Dim Plage As Range
'vide la plage de son contenu
ClVRPOM.Worksheets(Feuille).Columns(PlgCol).ClearContents
With ClBDD.Worksheets(Feuille)
'défini la plage de A1 à Ux
Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, Col).End(xlUp))
'effectue le filtrage...
Plage.AutoFilter Champ, "=" & Critere
'colle se dernier dans la feuille
.AutoFilter.Range.EntireRow.Copy ClVRPOM.Worksheets(Feuille).Range("A1")
End With
'suppression du filtre
Plage.AutoFilter
End SubC'est fantastique, le code fonctionne parfaitement.
Le seul petit inconvénient est qu'il faut renommer le workbooks "P204-0004_VRPOM" pour chaque fichier que je dois mettre à jour.
Mais ça va déjà me faire gagner un temps fou!
Merci beaucoup
Je viens de voir également que les formules ont été supprimées suite à l'utilisation du code, mais je ne vois pas pourquoi étant donné que les plages de données sont bien définies...
Je viens de voir également que les formules ont été supprimées suite à l'utilisation du code, mais je ne vois pas pourquoi étant donné que les plages de données sont bien définies...
effectivement, la copie d'un résultat de filtrage copie les lignes entières donc, utiliser un tableau pour la récup des valeurs !
Le seul petit inconvénient est qu'il faut renommer le workbooks "P204-0004_VRPOM" pour chaque fichier que je dois mettre à jour.
Comme dit dans un précédent post, il faut boucler sur les fichiers du dossier, voic à quoi peut ressembler le code :
Sub Test()
Dim ClBDD As Workbook
Dim ClVRPOM As Workbook
Dim Tbl() As String
Dim Chemin As String
Dim NomFe As String
Dim I As Integer
'classeur base de données
Set ClBDD = Workbooks("BDD.xlsx")
Chemin = "D:\Dossier1\Dossier2\" '<-- Attention ! Le dossier doit exister ! et ne doit contenir que les classeurs à traiter
'appel de la fonction pour la récupération de tous les classeurs du dossier...
Tbl() = RecupFichiers(Chemin)
'si le tableau a été initialisé car classeurs présents...
If Not Not Tbl Then
'gèle l'affichage pour éviter le scintillement
Application.ScreenUpdating = False
'...ouverture de tous les classeurs pour traitement
For I = 1 To UBound(Tbl)
'évite le cas où le classeur servant de base de données serait dans le même dossier que les classeurs à traiter
If InStr(Tbl(I), "BDD.xlsx") = 0 Then
Set ClVRPOM = Workbooks.Open(Tbl(I))
NomFe = "BI 2018"
Filtrage ClBDD, ClVRPOM, NomFe, ClVRPOM.Worksheets(NomFe).Range("N2").Value, 21, 14, "A:U"
NomFe = "CJIA 2018"
Filtrage ClBDD, ClVRPOM, NomFe, ClVRPOM.Worksheets(NomFe).Range("B2").Value, 23, 2, "A:W"
NomFe = "CJI3 2018"
Filtrage ClBDD, ClVRPOM, NomFe, ClVRPOM.Worksheets(NomFe).Range("T2").Value, 32, 20, "A:AF"
'enregistre et ferme
ClVRPOM.Close True
End If
Next I
End If
'rafraîchi
Application.ScreenUpdating = True
End Sub
Sub Filtrage(ClBDD As Workbook, _
ClVRPOM As Workbook, _
Feuille As String, _
Critere As String, _
Col As Integer, _
Champ As Integer, _
PlgCol As String)
Dim Plage As Range
Dim Tbl() As String
Dim I As Long
Dim J As Long
Dim K As Integer
'vide la plage de son contenu
'ClVRPOM.Worksheets(Feuille).Columns(PlgCol).ClearContents
With ClBDD.Worksheets(Feuille)
'défini la plage de A1 à Colx
Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, Col).End(xlUp))
'effectue le filtrage...
Plage.AutoFilter Champ, "=" & Critere
'boucle sur la plage à la recherche des cellules visibles, mets les valeurs dans un tableau...
For I = 1 To Plage.Rows.Count
If .Cells(I, 1).EntireRow.Hidden = False Then
J = J + 1: ReDim Preserve Tbl(1 To Col, 1 To J)
For K = 1 To Col: Tbl(K, J) = .Cells(I, K).Value: Next K
End If
Next I
'...et les colle après avoir vide la plage de son contenu
With ClVRPOM.Worksheets(Feuille)
.Columns(PlgCol).ClearContents
.Range(.Cells(1, 1), .Cells(UBound(Tbl, 2), Col)).Value = Application.Transpose(Tbl)
End With
End With
'suppression du filtre
Plage.AutoFilter
End Sub
Function RecupFichiers(Chemin As String) As String()
Dim TableauFichiers() As String
Dim Fichier As String
Dim I As Integer
'si seuls les.xlsx sont voulus,mettre "*.xlsx", idem pour les "*.xlsm"
Fichier = Dir(Chemin & "*.xls*")
Do While (Len(Fichier) > 0)
I = I + 1
ReDim Preserve TableauFichiers(1 To I)
TableauFichiers(I) = Chemin & Fichier
Fichier = Dir()
Loop
RecupFichiers = TableauFichiers()
End FunctionAttention, pour éviter tout couac, le dossier ne doit comporter que les classeurs à traiter, la base de données peut s'y trouver car un test est en place au cas où.
Je te conseille de mettre le code dans un classeur tiers ou à la limite dans celui servant de base de données mais bien entendu pas dans un classeur devant être traité.
Seuls le classeur contenant le code ci-dessus et la base de données doivent être ouverts, tous les autres devant absolument être fermés car sinon, plantage du code.
Adapter le chemin du dossier en début de procédure :
Chemin = "D:\Dossier1\Dossier2\"Je précise aussi que tous les classeurs doivent être structurés de façon identique et en ce qui concerne l'année, il te suffit, une fois 2018 mis à jour, de modifier les dates dans les trois affectation de valeur à la variable "NomFe" NomFe = "CJIA 2018"
Bonjour Theze,
Merci pour ce gros travail!
J'avais en effet prévu un classeur Excel dédié uniquement aux MACRO.
Penses-tu que je puisse définir plusieurs chemins d'accès aux fichiers à mettre à jour?
Exemple:
Chemin1 = "V:\POLE ACCOMPAGNEMENT\Cellule GP\Programmation\2019\BR 2019\1 - RBE\101-ADM1"
Chemin2 = "V:\POLE ACCOMPAGNEMENT\Cellule GP\Programmation\2019\BR 2019\1 - RBE\102-BE"
Chemin3 = "V:\POLE ACCOMPAGNEMENT\Cellule GP\Programmation\2019\BR 2019\1 - RBE\103-BIODIVHAL"
Je test tout cela Lundi, et te tiens au courant!
A+
Bonjour,
Avec plusieurs chemins stockés dans un Array pour faciliter l'accès avec une boucle :
Sub Test()
Dim ClBDD As Workbook
Dim ClVRPOM As Workbook
Dim Tbl() As String
Dim Tablo() As String
Dim T
Dim Chemin As String
Dim NomFe As String
Dim I As Integer
Dim J As Integer
Dim K As Integer
'classeur base de données
Set ClBDD = Workbooks("BDD.xlsx")
'les différents chemins dans un tableau
T = Array("V:\POLE ACCOMPAGNEMENT\Cellule GP\Programmation\2019\BR 2019\1 - RBE\101-ADM1\", _
"V:\POLE ACCOMPAGNEMENT\Cellule GP\Programmation\2019\BR 2019\1 - RBE\102-BE\", _
"V:\POLE ACCOMPAGNEMENT\Cellule GP\Programmation\2019\BR 2019\1 - RBE\103-BIODIVHAL\")
'récupération de tous les classeurs dans un seul tableau
For I = 0 To UBound(T)
Tablo() = RecupFichiers(T(I))
If Not Not Tablo Then
For J = 1 To UBound(Tablo)
K = K + 1: ReDim Preserve Tbl(1 To K)
Tbl(K) = Tablo(J)
Next J
End If
Next I
'si le tableau a été initialisé car classeurs présents...
If Not Not Tbl Then
'gèle l'affichage pour éviter le scintillement
Application.ScreenUpdating = False
'...ouverture de tous les classeurs pour traitement
For I = 1 To UBound(Tbl)
'évite le cas où le classeur servant de base de données serait dans le même dossier que les classeurs à traiter
If InStr(Tbl(I), "BDD.xlsx") = 0 Then
Set ClVRPOM = Workbooks.Open(Tbl(I))
NomFe = "BI 2018"
Filtrage ClBDD, ClVRPOM, NomFe, ClVRPOM.Worksheets(NomFe).Range("N2").Value, 21, 14, "A:U"
NomFe = "CJIA 2018"
Filtrage ClBDD, ClVRPOM, NomFe, ClVRPOM.Worksheets(NomFe).Range("B2").Value, 23, 2, "A:W"
NomFe = "CJI3 2018"
Filtrage ClBDD, ClVRPOM, NomFe, ClVRPOM.Worksheets(NomFe).Range("T2").Value, 32, 20, "A:AF"
'enregistre et ferme
ClVRPOM.Close True
End If
Next I
End If
'rafraîchi
Application.ScreenUpdating = True
End SubBonjour Theze,
J'ai commencé par tester le 1er code (avec un seul chemin) pour faire au plus simple.
J'ai corrigé quelque bug qui étaient liés au fait que certains fichiers étaient en XLSX et d'autres en XLSM.
Par contre je sèche sur l'erreur suivante:
Sub Filtrage(ClTESTBDD As Workbook, _
ClVRPOM As Workbook, _
Feuille As String, _
Critere As String, _
Col As Integer, _
Champ As Integer, _
PlgCol As String)
Dim Plage As Range
Dim Tbl() As String
Dim I As Long
Dim J As Long
Dim K As Integer
'vide la plage de son contenu
ClVRPOM.Worksheets(Feuille).Columns(PlgCol).ClearContents
With ClTESTBDD.Worksheets(Feuille)
Sur cette ligne en rouge j'ai l'erreur "l'indice n'appartient pas à la sélection".
J'ai testé de remplacer "worksheets" par "sheets" comme il est indiqué sur certains forums, mais l'erreur persiste.
As-tu une idée?
Guillaume
Bonjour,
C'est très simple, la variable "Feuille" contient un de ces trois noms selon le cas : "BI 2018", "CJIA 2018" et "CJI3 2018" et dans le classeur cible (ta base de données à priori), une des feuilles visées est probablement orthographié légèrement différemment, espace en trop, lettre en minuscule, etc...
Contrôle les noms des feuilles du classeur car la "bI 2018" est différent de "BI 2018" !
J'ai corrigé quelque bug qui étaient liés au fait que certains fichiers étaient en XLSX et d'autres en XLSM.
Il n'y a aucune raison qu'il y est un bug car la fonction de récupération de fichiers permet justement de les récupérer sans discrimination avec la présence des astérisques qui entourent l'extension de bas ".xls" :
Fichier = Dir(Chemin & "*.xls*")Tu peux d'ailleurs tester avec ces lignes de code sur un dossier contenant des .xlsx, xlsm, xlsb (résultat dans la fenêtre d'exécution Ctrl+G) :
Tbl() = RecupFichiers(Chemin)
For I = 1 To UBound(Tbl): Debug.Print Tbl(I): Next I
StopHello,
Tu as raison c'était bien une erreur d'orthographe d'un onglet qui entrainait le problème.
J'ai fais un test en précisant un chemin qui menait à une dizaine de classeurs Excels, et le code a fonctionné.
J'ai seulement un problème avec le format des données qui sont collées. Je me rend compte que certaines données sont collées en format standard ou texte alors que ce sont des nombre ou des dates. Et ce phénomène semble être très aléatoires, car seul certaines lignes sont concernées.
J'ai donc testé cela:
.Range(.Cells(1, 1), .Cells(UBound(Tbl, 2), Col)).Value = Application.Paste(Tbl)
J'ai remplacé Transpose par Paste, mais cela génère l'erreur d'exécution438:"propriété ou méthode non gérée par cet objet".
Bonjour,
.Range(.Cells(1, 1), .Cells(UBound(Tbl, 2), Col)).Value = Application.Paste(Tbl)
Ce serait trop simple ! Dans ce cas de figure, le compilateur de sait pas coller un tableau mais seulement un Range pour un tableau, il y a affectation des données.
Plusieurs solutions peuvent être envisagées, la première est de forcer le format dans la ou les colonnes incriminées sans avoir forcément le résultat escompté car Excel est parfois têtu !
La seconde, serait d'utiliser plusieurs tableaux pour la récup en les typant explicitement mais le temps d'exécution s'en trouverait allongé et sur 500 fichiers ???
La troisième serait d'effectuer une copie de la base de données, d'appliquer les formules dans les colonnes concernées et de revenir au code initial (copie du filtrage) ce qui à mon avis embarquerait les formules avec le reste.
Quelles sont les colonnes qui posent problème, car dans ta base de données, si par exemple je prend la feuille "BI 2018", les colonnes de A à S sont au format texte malgré des colonnes contenant des nombres, la colonne T est au format nombre et U au format date ce sont ces dernières qui posent problème ?
Déjà, dans ta base de données dans la feuille "BI 2018" par exemple il y a des incohérences, les trois quarts des colonnes (A à C, E, H et K) contenant des nombres sont considérés comme étant du texte je pense que de là vient le problème, le compilateur ne sachant pas vraiment quel type de format appliquer !
Bonjour,
il est vrai que la base de données BI 2018 contient du format texte (données extraite du logiciel).
Mais ce n'est pas gênant tant que la colonne "T" qui contient la valeur cherchée soit au format nombre.
Pour l'onglet CJIA 2018 c'est plus complexe, car la colonne "A" et "P" doit être au format date, la "F" au format nombre.
Je vais voir si je peux extraire du logiciel un format Excel plus homogène, pour éviter ces problèmes.
Bonne journée!