appliquer filtre sur fichier unique, puis copier coller le résultat

Y compris Power BI, Power Query et toute autre question en lien avec Excel
T
Theze
Passionné d'Excel
Passionné d'Excel
Messages : 4'020
Appréciations reçues : 305
Inscrit le : 26 janvier 2011
Version d'Excel : 2007/2019

Message par Theze » 21 février 2019, 13:29

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 ::o
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.
Il vaut mieux un qui sait que cent qui cherchent :wink:

Ce forum étant un lieu de partage, je n'accepte pas les messages privés !
Avatar du membre
Steelson
Fanatique d'Excel
Fanatique d'Excel
Messages : 13'515
Appréciations reçues : 753
Inscrit le : 13 octobre 2014
Version d'Excel : 2013 FR
Téléchargements : Mes applications

Message par Steelson » 21 février 2019, 13:32

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).

O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸ O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸
PI = 3.14159 26535 89793 23846 26433 83279 50288 41971 69399 37510 58209 74944 59230 78164 06286 20899 86280

( ͡• ͜ʖ ͡• )
g
gperros
Jeune membre
Jeune membre
Messages : 30
Inscrit le : 6 octobre 2014
Version d'Excel : 2007

Message par gperros » 21 février 2019, 14:43

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 :lole:

J'espère que le pas à pas est assez clair cette fois-ci.

Merci encore!
BDD.xlsx
(452.23 Kio) Téléchargé 4 fois
T
Theze
Passionné d'Excel
Passionné d'Excel
Messages : 4'020
Appréciations reçues : 305
Inscrit le : 26 janvier 2011
Version d'Excel : 2007/2019

Message par Theze » 22 février 2019, 07:46

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 Sub
Il vaut mieux un qui sait que cent qui cherchent :wink:

Ce forum étant un lieu de partage, je n'accepte pas les messages privés !
g
gperros
Jeune membre
Jeune membre
Messages : 30
Inscrit le : 6 octobre 2014
Version d'Excel : 2007

Message par gperros » 22 février 2019, 09:47

C'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
g
gperros
Jeune membre
Jeune membre
Messages : 30
Inscrit le : 6 octobre 2014
Version d'Excel : 2007

Message par gperros » 22 février 2019, 10:04

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...
T
Theze
Passionné d'Excel
Passionné d'Excel
Messages : 4'020
Appréciations reçues : 305
Inscrit le : 26 janvier 2011
Version d'Excel : 2007/2019

Message par Theze » 22 février 2019, 16:07

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 Function
Attention, 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"
Il vaut mieux un qui sait que cent qui cherchent :wink:

Ce forum étant un lieu de partage, je n'accepte pas les messages privés !
g
gperros
Jeune membre
Jeune membre
Messages : 30
Inscrit le : 6 octobre 2014
Version d'Excel : 2007

Message par gperros » 24 février 2019, 12:00

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+
;;)
T
Theze
Passionné d'Excel
Passionné d'Excel
Messages : 4'020
Appréciations reçues : 305
Inscrit le : 26 janvier 2011
Version d'Excel : 2007/2019

Message par Theze » 25 février 2019, 07:15

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 Sub
Il vaut mieux un qui sait que cent qui cherchent :wink:

Ce forum étant un lieu de partage, je n'accepte pas les messages privés !
g
gperros
Jeune membre
Jeune membre
Messages : 30
Inscrit le : 6 octobre 2014
Version d'Excel : 2007

Message par gperros » 25 février 2019, 11:32

Bonjour 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
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message