Rapatrier des données de plusieurs fichiers dans un seul fichier et sous conditions

[misere59]

Bonjour à tous,

Nouveau sur ce forum, je m’adresse à vous pour m’aider à solutionner une problématique.

Mais auparavant, je pense qu’il est de bon ton de faire un état des lieux :

J’ai 36 ans et j’ai décidé de prendre un congé formation de 20 mois et de reprendre les études pour décrocher un diplôme d’ingénieur (et c’est dur, dur !!!).
Dans le cadre de mon stage de fin d’études, je suis amené à créer des indicateurs mensuels et de capitaliser ces informations dans un tableau de bord ; et bien sur de façon la plus automatique possible…

… et je me suis fracassé face un mur : créer des macros sous Excel 2007. Développeur est un métier et souvent un art que je n’ai pas.

Rentrons maintenant dans le vif du sujet :

Sur une périodicité mensuelle, je souhaiterai rapatrier certaines données contenu dans des fichiers Excel ayant la même structure dans un seul fichier qui ce nomme TdB.xlsm (en PJ).

J’ai imaginé la méthode comme suit :

1. Dans le fichier TdB.xlsm, j’ai créé un onglet " KPI_3_Accueil " ou je choisi le mois de mise à jour dans la cellule "C7" (exemple : juillet-12).

2. Avant, il faudra créer manuellement le répertoire de ce mois (ex : "1207_Synthèse_Affaires" pour le moins de juillet 2012) contenant tous les fichiers *.xls suivant le chemin défini ci-dessous :
O:\2-ICS France\DP_Contrats_PMO\Gestion_Risques\3_Traitement_Risques\1-Traitement_Fiches\"répertoire".

3. Ensuite, je lance la macro (appui sur le bouton "MAJ" qui est situé dans l’onglet "KPI_3_Données").

Et à partir de là, c’est le drame… car je suis bloqué…

L’objectif principal souhaité de cette macro :

Pour chaque fichier *.xls, cette macro doit seulement copier dans l’onglet "7 - Synthese des Risques" tous les lignes dont le type est "R" (colonne A, à partir de la ligne 16) et dont le "Statut" (colonne H, à partir de la ligne 16) est soit :
o Avéré
o Evité (externe)
o Evité (suite action)

En conclusion et pour cette étape, il faut copier que les données contenues dans les colonnes A, B, H et V, toujours en tenant compte de la condition ci-dessous (en exemple, dans le fichier "source" en pj, j’ai surligné en jaune ce qu’il faut rapatrier, attention j’ai filtré au niveau du statut).

Ensuite, la macro retourne dans l’onglet "KPI_3_Données" du fichier TdB.xlsm et colle toutes les données à partir de la ligne 4 dans le mois et l’année de référence. Et ainsi de suite pour chaque fichier (1 fichier = 1 projet).

Vous pouvez voir dans cet onglet un exemple du résultat voulu pour le mois de juillet (Attention, ici c’est pour un seul projet. Il y a plusieurs projets dans le mois et leur nombre est variable).

Voilà, pour la description de cette macro.

Au début pour la réaliser, j’étais parti d’une macro exemple (en pj) que ma tutrice de stage m’a donnée.
Mais je n’arrive pas à l’adapter selon mes besoins propres, de plus je n’ai pas le référentiel d’un développeur et je ne maitrise pas assez le VB.

Donc je m’adresse à toutes les personnes de bonne volonté pour m’aider.
J’espère avoir été le plus clair possible et reste dispo pour tous renseignements complémentaires.

… et d’avance merci
Seb

 

[Staple1600]

Re : Rapatrier des données de plusieurs fichiers dans un seul fichier et sous conditi

Bonjour et bienvenue

Juste pour te dire bravo pour ce message, Seb.

On aimerait en voir comme cela plus souvent de la part des nouveaux membres.

Je laisse la place aux autres qui ne tarderont pas à venir t'aider.

 

[Staple1600]

Re : Rapatrier des données de plusieurs fichiers dans un seul fichier et sous conditi

Bonjour

Je mets le code de ton module (en espérant que cela attire d'autres lecteurs dans ton fil)
A première lecture, je pense qu'on pourrait utiliser un filtre automatique (voire un filtre élaboré) associé à la fonction SOUS.TOTAL.
Est-ce que tu vois de quoi je veux parler?
ou dois-je mettre les mains dans le cambouis ?

Sub mise_jour_etat_fiche_2011()

Dim FSO As Scripting.FileSystemObject
Dim DossierFichiers As String
Dim DossierSource As Scripting.Folder
Dim Fichier As Scripting.File
Dim i, j As Long
Dim ws As Worksheet
Dim nom, nom_prog As String
Dim nb_identifie As Integer
Dim clos, cours, report, retard As Integer

    'pour éviter affichage des fenetres
    Application.ScreenUpdating = False

    'on récupère la colonne de la date de MAJ en cours
    col = 4
    While (ThisWorkbook.Sheets("Récapitulatif_2011").Cells(2, col).Value <> ThisWorkbook.Sheets("Accueil").Cells(10, 3).Value)
        col = col + 16
    Wend
    
    'suppression des anciennes valeurs (attention : remplacer le nombre de la dernière ligne si nouvelle affaire)
    ThisWorkbook.Sheets("Récapitulatif_2011").Range(Cells(6, col), Cells(59, col + 1)).Value = ""
    ThisWorkbook.Sheets("Récapitulatif_2011").Range(Cells(6, col + 3), Cells(59, col + 7)).Value = ""
    ThisWorkbook.Sheets("Récapitulatif_2011").Range(Cells(6, col + 9), Cells(59, col + 10)).Value = ""
    ThisWorkbook.Sheets("Récapitulatif_2011").Range(Cells(6, col + 12), Cells(59, col + 12)).Value = ""
    ThisWorkbook.Sheets("Récapitulatif_2011").Range(Cells(6, col + 14), Cells(59, col + 14)).Value = ""
    
    
    DossierFichiers = ThisWorkbook.Sheets("Accueil").Range("Chemin").Value
    If Dir(DossierFichiers, vbDirectory) = "" Then
    Call MsgBox("Le dossier spécifié en page d'Accueil n'existe pas.", vbOKOnly, "Message d'erreur")
    Else
    
    Set FSO = New Scripting.FileSystemObject
    Set DossierSource = FSO.GetFolder(DossierFichiers)


    For Each Fichier In DossierSource.files
        Application.Workbooks.Open Fichier
        
        clos = 0
        cours = 0
        report = 0
        retard = 0
        nb_fiche_R = 0
        nb_fiche_ann = 0
        nb_fiche_ev_ext = 0
        nb_fiche_ev_action = 0
        nb_fiche_R = 0
        nb_fiche_avere = 0
        nb_fiche_O = 0
        nb_fiche_gagnee_O = 0
        nb_fiche_perdue_O = 0
        nb_fiche_ann_O = 0
        cout_pond_R = 0
        cout_pond_O = 0
   
            '*************************************
            'traitement fiche par fiche
            '*************************************
            
        For Each ws In Worksheets
        
        ws.Activate
    
        Select Case ws.Name
        Case "Evolution":
        Case "Lisez moi":
        Case "R&O Log":
        Case "R&O Log_Italie":
        Case "FormulaireR":
        Case "FormulaireO":
        Case "Risk Track":
        Case "template":
        Case "Accueil":
        Case "Liste_actions":
        Case "Data":
        Case Else:
        
        nom = ws.Name
        
        'pour les Risques
        If ActiveWorkbook.Sheets(nom).Range("Type").Value = "R" Then
             If ActiveWorkbook.Sheets(nom).Range("Statut").Value = "Identifié" Or ActiveWorkbook.Sheets(nom).Range("Statut").Value = "En cours" Then
                nb_fiche_R = nb_fiche_R + 1
                cout_pond_R = cout_pond_R + ActiveWorkbook.Sheets(nom).Range("cout_pond").Value
             ElseIf ActiveWorkbook.Sheets(nom).Range("Statut").Value = "Avéré" Then
                nb_fiche_avere = nb_fiche_avere + 1
             ElseIf ActiveWorkbook.Sheets(nom).Range("Statut").Value = "Evité (suite actions)" Then
                nb_fiche_ev_action = nb_fiche_ev_action + 1
             ElseIf ActiveWorkbook.Sheets(nom).Range("Statut").Value = "Evité (externe)" Then
                nb_fiche_ev_ext = nb_fiche_ev_ext + 1
             ElseIf ActiveWorkbook.Sheets(nom).Range("Statut").Value = "Annulé" Then
                nb_fiche_ann = nb_fiche_ann + 1
             End If

            If ActiveWorkbook.Sheets(nom).Cells(12, 3).Value <> "DUBAI OCS" Then
                If ActiveWorkbook.Sheets(nom).Cells(37, 8).Value = "Majeur" Or ActiveWorkbook.Sheets(nom).Cells(37, 8).Value = "Critique" Then
                    If ActiveWorkbook.Sheets(nom).Range("Statut").Value = "Identifié" Or ActiveWorkbook.Sheets(nom).Range("Statut").Value = "En cours" Then
                
                    i = 0
                    While (Cells(60 + i, 2).Value <> "")
                        DoEvents
                        If ActiveWorkbook.Sheets(nom).Cells(60 + i, 13).Value = "close" Then
                            clos = clos + 1
                        ElseIf ActiveWorkbook.Sheets(nom).Cells(60 + i, 13).Value = "en retard" Then
                            retard = retard + 1
                        ElseIf ActiveWorkbook.Sheets(nom).Cells(60 + i, 13).Value = "en cours" Then
                            cours = cours + 1
                        ElseIf ActiveWorkbook.Sheets(nom).Cells(60 + i, 13).Value = "reportée" Then
                            report = report + 1
                        End If
                        i = i + 1
                    Wend
                    End If
                End If
            ' cas particulier de DUBAI (outil R&O modifié pour création onglet "R&O Log_Italie")
            ElseIf ActiveWorkbook.Sheets(nom).Cells(12, 3).Value = "DUBAI OCS" Then
                If ActiveWorkbook.Sheets(nom).Cells(39, 8).Value = "Majeur" Or ActiveWorkbook.Sheets(nom).Cells(39, 8).Value = "Critique" Then
                    If ActiveWorkbook.Sheets(nom).Range("Statut").Value = "Identifié" Or ActiveWorkbook.Sheets(nom).Range("Statut").Value = "En cours" Then
                    
                    i = 0
                    While (Cells(63 + i, 2).Value <> "")
                        DoEvents
                        If ActiveWorkbook.Sheets(nom).Cells(63 + i, 13).Value = "close" Then
                            clos = clos + 1
                        ElseIf ActiveWorkbook.Sheets(nom).Cells(63 + i, 13).Value = "en retard" Then
                            retard = retard + 1
                        ElseIf ActiveWorkbook.Sheets(nom).Cells(63 + i, 13).Value = "en cours" Then
                            cours = cours + 1
                        ElseIf ActiveWorkbook.Sheets(nom).Cells(63 + i, 13).Value = "reportée" Then
                            report = report + 1
                        End If
                        i = i + 1
                    Wend
                    End If
                End If
            End If
              
        
        'pour les Opportunités
        ElseIf ActiveWorkbook.Sheets(nom).Range("Type").Value = "O" Then
             If ActiveWorkbook.Sheets(nom).Range("Statut").Value = "Identifiée" Or ActiveWorkbook.Sheets(nom).Range("Statut").Value = "En cours" Then
                nb_fiche_O = nb_fiche_O + 1
                cout_pond_O = cout_pond_O + ActiveWorkbook.Sheets(nom).Range("cout_pond").Value
                
                i = 0
                While (Cells(60 + i, 2).Value <> "")
                    DoEvents
                    If ActiveWorkbook.Sheets(nom).Cells(60 + i, 13).Value = "close" Then
                        clos = clos + 1
                    ElseIf ActiveWorkbook.Sheets(nom).Cells(60 + i, 13).Value = "en retard" Then
                        retard = retard + 1
                    ElseIf ActiveWorkbook.Sheets(nom).Cells(60 + i, 13).Value = "en cours" Then
                        cours = cours + 1
                    ElseIf ActiveWorkbook.Sheets(nom).Cells(60 + i, 13).Value = "reportée" Then
                        report = report + 1
                    End If
                    i = i + 1
                Wend
             ElseIf ActiveWorkbook.Sheets(nom).Range("Statut").Value = "Gagnée" Then
                nb_fiche_gagnee_O = nb_fiche_gagnee_O + 1
             ElseIf ActiveWorkbook.Sheets(nom).Range("Statut").Value = "Perdue" Then
                nb_fiche_perdue_O = nb_fiche_perdue_O + 1
             ElseIf ActiveWorkbook.Sheets(nom).Range("Statut").Value = "Annulée" Then
                nb_fiche_ann_O = nb_fiche_ann_O + 1
             End If
        End If
        End Select
        Next ws
        
        nom_prog = ActiveWorkbook.Sheets("Accueil").Range("NProg").Value
        ActiveWorkbook.Close False
        
        Index = 6
        While (ThisWorkbook.Sheets("Récapitulatif_2011").Cells(Index, 2).Value <> nom_prog)
            Index = Index + 2
        Wend
        
        ThisWorkbook.Sheets("Récapitulatif_2011").Cells(Index, col).Value = nb_fiche_R + nb_fiche_ann + nb_fiche_ev_ext + nb_fiche_ev_action + nb_fiche_avere
        ThisWorkbook.Sheets("Récapitulatif_2011").Cells(Index, col + 3).Value = nb_fiche_avere
        ThisWorkbook.Sheets("Récapitulatif_2011").Cells(Index, col + 4).Value = nb_fiche_ev_action
        ThisWorkbook.Sheets("Récapitulatif_2011").Cells(Index, col + 5).Value = nb_fiche_ev_ext
        ThisWorkbook.Sheets("Récapitulatif_2011").Cells(Index, col + 6).Value = nb_fiche_ann
        ThisWorkbook.Sheets("Récapitulatif_2011").Cells(Index, col + 7).Value = cout_pond_R

        ThisWorkbook.Sheets("Récapitulatif_2011").Cells(Index + 1, col).Value = nb_fiche_O + nb_fiche_gagnee_O + nb_fiche_perdue_O + nb_fiche_ann_O
        ThisWorkbook.Sheets("Récapitulatif_2011").Cells(Index + 1, col + 3).Value = nb_fiche_gagnee_O
        ThisWorkbook.Sheets("Récapitulatif_2011").Cells(Index + 1, col + 4).Value = nb_fiche_perdue_O
        ThisWorkbook.Sheets("Récapitulatif_2011").Cells(Index + 1, col + 6).Value = nb_fiche_ann_O
        ThisWorkbook.Sheets("Récapitulatif_2011").Cells(Index + 1, col + 7).Value = cout_pond_O
        
        ThisWorkbook.Sheets("Récapitulatif_2011").Cells(Index, col + 9).Value = retard + cours + report
        ThisWorkbook.Sheets("Récapitulatif_2011").Cells(Index, col + 10).Value = retard
        ThisWorkbook.Sheets("Récapitulatif_2011").Cells(Index, col + 12).Value = report
        ThisWorkbook.Sheets("Récapitulatif_2011").Cells(Index, col + 14).Value = cours
    Next Fichier
    End If
    
    'calcul du nombre de nouvelles fiches créées par programme
    colonne = 76
    While (ThisWorkbook.Sheets("Liste Globale_Fiches").Cells(3, colonne).Value <> ThisWorkbook.Sheets("Accueil").Cells(10, 3).Value)
        colonne = colonne + 1
    Wend
    
    ligne = 636
    While ThisWorkbook.Sheets("Liste Globale_Fiches").Cells(ligne, 1).Value <> ""
    DoEvents
    If ThisWorkbook.Sheets("Liste Globale_Fiches").Cells(ligne, colonne).Value = "Création" Then
    
        nom_prog = ThisWorkbook.Sheets("Liste Globale_Fiches").Cells(ligne, 2).Value
        type_fiche = Split(ThisWorkbook.Sheets("Liste Globale_Fiches").Cells(ligne, 3).Value, "/")
        
        Index_bis = 6
        While (ThisWorkbook.Sheets("Récapitulatif_2011").Cells(Index_bis, 2).Value <> nom_prog)
            Index_bis = Index_bis + 2
        Wend
        If type_fiche(0) = "R" Then
            ThisWorkbook.Sheets("Récapitulatif_2011").Cells(Index_bis, col + 1).Value = ThisWorkbook.Sheets("Récapitulatif_2011").Cells(Index_bis, col + 1).Value + 1
        ElseIf type_fiche(0) = "O" Then
            ThisWorkbook.Sheets("Récapitulatif_2011").Cells(Index_bis + 1, col + 1).Value = ThisWorkbook.Sheets("Récapitulatif_2011").Cells(Index_bis + 1, col + 1).Value + 1
        End If
    End If
    ligne = ligne + 1
    Wend
End Sub

 

[misere59]

Re : Rapatrier des données de plusieurs fichiers dans un seul fichier et sous conditi

Bonjour à tous,

Je me permet de relancer ma demande pendant que je suis en train de faire le tour de ce forum.
Je trouve beaucoup de choses très intéressantes mais pas une alternative que je pourrai adapter à ma problématique.
Pouvez-vous m'aider à résoudre ce problème qui va certainement vous sembler simple, mais pour lequel je ne sais pas trouver de solution?

 

[Staple1600]

Re : Rapatrier des données de plusieurs fichiers dans un seul fichier et sous conditi

Re

Tu as lu mon précédent message que je viens de poster 2 minutes avant toi ?

 

[misere59]

Re : Rapatrier des données de plusieurs fichiers dans un seul fichier et sous conditi

Re JM,

je pense qu'on pourrait utiliser un filtre automatique (voire un filtre élaboré) associé à la fonction SOUS.TOTAL.
Est-ce que tu vois de quoi je veux parler?
ou dois-je mettre les mains dans le cambouis ?

Je ne vois pas trop ce que cela veux dire... par contre, je suis amateur d'éclaircissement à ce sujet
... mais si tu veux bien mettre aussi tes mains dans le cambouis, 2 personnes cela ne serait pas de trop!

 

[Staple1600]

Re : Rapatrier des données de plusieurs fichiers dans un seul fichier et sous conditi

Re

OK, j'enfile mon marcel et j'arrive

PS: en joignant plutôt des *.xls, plus de monde ici sera susceptible de te venir en aide.

NB: Au fait tu es sûr que tes fichiers ne contiennent rien de confidentiel ?

 

[misere59]

Re : Rapatrier des données de plusieurs fichiers dans un seul fichier et sous conditi

J'ai regardé sur le forum les filtre autoavec la fonction sous total: https://www.excel-downloads.com/threads/fonction-sous-total-avec-filtre-automatique.73113/

Cela a l'air d'être une bonne piste pour ca:

Pour chaque fichier *.xls, cette macro doit seulement copier dans l’onglet "7 - Synthese des Risques" tous les lignes dont le type est "R" (colonne A, à partir de la ligne 16) et dont le "Statut" (colonne H, à partir de la ligne 16) est soit :
o Avéré
o Evité (externe)
o Evité (suite action)

Mais après, pour la compilation des données dans un seul fichier, je dois passer nécessairement par une macro?

 

[misere59]

Re : Rapatrier des données de plusieurs fichiers dans un seul fichier et sous conditi

PS: en joignant plutôt des *.xls, plus de monde ici sera susceptible de te venir en aide.

NB: Au fait tu es sûr que tes fichiers ne contiennent rien de confidentiel ?

Si j'avais su! J'ai converti les fichiers en conséquence...
...et les fichiers ont été purgé avant envoi, mais bon, on est a l'abri de rien.
il faut bien que j'avance durant ce stage et je suis déjà bien en retard, et dans mon service, il n'y a personne de disponible pour me guider...

 

[Staple1600]

Re : Rapatrier des données de plusieurs fichiers dans un seul fichier et sous conditi

Re


Voici ce que je voulais dire à propos de l'emploi du filtre élaboré et de SOUS.TOTAL
Exécutes la macro ci-dessous sur le classeur: source.xlsx
(PS: ici, j'ai tout passé en *.xls)

Sub Macro1()
' Macro1 Macro
' Macro enregistrée le 30/07/2012 par Staple1600
Range("A1") = "Typ": Range("A2") = "R": Range("D1") = "nb"
Range("D2").FormulaR1C1 = "=SUBTOTAL(3,R[12]C[4]:R[111]C[4])"
Range("B2").FormulaR1C1 = "=OR(LEFT(R[12]C[6],2)=""Av"",LEFT(R[12]C[6],2)=""Ev"")"
Range("A13:AG112").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Range("A1:B2"), Unique:=False
End Sub

Vois-tu désormais ce qu'on pourrait faire avec ce type de code pour résoudre ta problématique actuelle?

 

[misere59]

Re : Rapatrier des données de plusieurs fichiers dans un seul fichier et sous conditi

Re Staple

J'ai testé ta macro sur le fichier source et j'ai pu voir ce qu'elle fait, en effet c'est pertinent comme idée, merci

en fait elle trie et sélectionne les lignes selon les conditions initiales, mais après comment rapatrier ces données dans mon TdB?

il faut faire une deuxième macro ou développer la première? Tu vois c'est à partir de choses simples comme cela que je bute.

Ensuite je l'ai essayé sur mon fichier original, et là... c'est Beyrouth!!! (mais cela doit être normal je pense)

 

[Staple1600]

Re : Rapatrier des données de plusieurs fichiers dans un seul fichier et sous conditi

Re


Quelle est ton arborescence exacte ?
DossierFichiers = ThisWorkbook.Sheets("KPI_3_Accueil").Range("Chemin").Value
est à égal à juillet-2012
ce qui ne ressemble pas vraiment à un chemin (ou path)

 

[misere59]

Re : Rapatrier des données de plusieurs fichiers dans un seul fichier et sous conditi

Re,

Je ne peux te joindre le fichier original, il est un peu plus gros (890mb)
C'est dommage, car tu aurais vu le résultat.

 

[misere59]

Re : Rapatrier des données de plusieurs fichiers dans un seul fichier et sous conditi

Quelle est ton arborescence exacte ?

Pour répondre clairement à cette question:
O:\2-ICS France\DP_Contrats_PMO\Gestion_Risques\3_Traitement_Risques\1-Traitement_Fiches\1207_Synthèse_Affaires (pour les affaires traités au mois de juillet 2012)

Mais tous les mois on crée manuellement un nouveau répertoire (ex: 1208_Synthèse_Affaires pour le mois d'aout 2012).

J'espère avoir répondu à ta question.

Mais, je ne vois pas très bien ou tu veux en venir? c'est pas très clair dans mon esprit

 

[Staple1600]

Re : Rapatrier des données de plusieurs fichiers dans un seul fichier et sous conditi

Re

Pour ce qui est de la recopie (toujours ici en version de test)
Créé au préalable une seconde feuille (juste pour faire le test)
Les données utiles seront recopiées sur cette feuille 2
Maintenant il s'agit d'implémenter cette macro de test dans ton code initial.
Tu vois comment faire ou pas ?

Sub Macro1BIS()
' Macro1 Macro
' Macro enregistrée le 30/07/2012 par Staple1600
Dim i, j
Range("A1") = "Typ": Range("A2") = "R": Range("D1") = "nb"
Range("D2").FormulaR1C1 = "=SUBTOTAL(3,R[12]C[4]:R[111]C[4])"
Range("B2").FormulaR1C1 = "=OR(LEFT(R[12]C[6],2)=""Av"",LEFT(R[12]C[6],2)=""Ev"")"
Range("A13:AG112").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Range("A1:B2"), Unique:=False
        j = 1
For i = 1 To [_FilterDataBase].Columns.Count
Select Case i
Case 2, 5, 8, 22
[_FilterDataBase].Columns(i).SpecialCells(12).Copy Sheets(2).Cells(1, j)
j = j + 1
End Select
Next i
End Sub

PS: Sinon, membres du forum à la fibre répondante, n'hésitez pas à vous arrêter dans ce fil pour un petit coup de main
Merci d'avance.