Récupération de données dans plusieurs dossier

Bonjour à tous,

j'ai besoin d'un coup de main pour réaliser mon besoin. Pour info je n'y connais pas grand chose en VBA.

je vais tenter d'être le plus clair possible.

• j'ai un dossier principal qui s'appelle 2017
• dans ce dossier, j'ai 12 dossiers qui ont chacun le nom de chaque mois de l'année écrit de cette manière:

02_Fevrier 2017

03_etc....

- dans chacun des 12 dossiers, il y a un nombre de classeurs correspondant à chaque jour du mois avec comme intitulé:

planning 2017-01-01Di.xls

planning 2017-01-02Di.xls

etc.... comme çela dans chaque dossier.

- chaque classeur est identique dans sa conception, la seule variable c'est l'arrivée ou le départ d'un collaborateur. (voir fichier joint)

Ma demande:

à partir d'un nouveau classeur que je vais nommer Vérification jours travaillés, je voudrais avoir une cellule dans laquelle j'indiquerai le nom que je souhaite vérifier. En dessous, un bouton pour lancer la recherche.

La recherche doit balayer chaque classeur ( feuille nuit seulement concerné)de chaque dossier du dossier 2017. Lors de la recherche, le code doit vérifier le nom car durant l'année le nom peut avoir changé de place dans la colonne ou ne pas y figurer tout simplement.

Quand le nom est trouvé, il doit copier dans le classeur Vérification jours travaillés les informations suivantes:

le nom du classeur puis les deux cellules qui sont à coté du nom dans le classeur source.

Après avoir refait une explication, j’espère avoir été clair.

Merci à tous pour votre aide

Bonjour,

une proposition

Sub aargh()
    Application.ScreenUpdating = False
    Set wso = ThisWorkbook.Sheets("modèle classeur de recherche")
    nom = wso.Range("B7")
    dlo = wso.Cells(Rows.Count, 1).End(xlUp).Row
    wso.Range("A13:C" & dlo).ClearContents
    k = 12
    rpath = "d:\downloads\" 'à adapter
    année = 2017
    tabmois = Split("Janvier,Février,Mars,Avril,Mai,Juin,Juillet,Août, Septembre,Octobre,Novembre,Décembre", ",") ' à adapter
    For mois = 1 To 12
        eom = Day(Application.WorksheetFunction.EoMonth(DateSerial(année, mois, 1), mois - 1))
        For jour = 1 To eom
            dateencours = DateSerial(année, mois, jour)
            rep = rpath & année & "\" & tabmois(mois - IIf(LBound(tabmois) = 0, 1, 0)) & "\" & Format(dateencours, "dd-mm") & ".xlsx"
            fn = Dir(rep)
            If fn = "" Then
                'MsgBox "fichier " & rep & " non trouvé"
            Else
                Set wb = Workbooks.Open(rep)
                Set ws = wb.Sheets(1)
                dl = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
                Set re = ws.Range("A1:A" & dl).Find(nom, lookat:=xlWhole, MatchCase:=False)
                If Not re Is Nothing Then
                    k = k + 1
                    wso.Cells(k, 1) = dateencours
                    wso.Cells(k, 2).Resize(, 2).Value = re.Offset(, 1).Resize(, 2).Value
                End If
                wb.Close False
            End If
        Next jour
    Next mois
    Application.ScreenUpdating = True
End Sub

je dois me tromper quelque part et je pense que je n'ai pas été assez précis.

Je ré-édite ma demande ci dessus car la je n'arrive pas à le faire fonctionner.

Merci

Bonjour,

je t'ai mis une nouvelle version qui correspond à tes nouvelles spécifications.

Sub aargh()
    Application.ScreenUpdating = False
    k = 11    'ligne titre résultat recherche
    Set wso = ThisWorkbook.Sheets("feuil1")    'feuille de départ pour la recherche
    nom = wso.Range("B3")    'nom recherché
    dlo = wso.Cells(Rows.Count, 2).End(xlUp).Row    'nombre de lignes résultat présentes dans la feuil recherche
    If dlo = k Then dlo = k + 1
    wso.Range("B12:D" & dlo).ClearContents    'on efface le résultat de la recherche précédente
    rpath = "d:\downloads\"    'répertoire dans lequel se trouve le répertoire 2017
    année = 2017
    tabmois = Split("01_Janvier,02_Fevrier,03_Mars,04_Avril,05_Mai,06_Juin,07_Juillet,08_Aout,09_Septembre,10_Octobre,11_Novembre,12_Decembre", ",")    ' tableau des répertoires des mois
    For mois = 1 To 12    'on parcourt les 12 mois
        dateencours = DateSerial(année, mois, 1)
        rep = rpath & année & "\" & tabmois(mois - IIf(LBound(tabmois) = 0, 1, 0)) & " " & année & "\"    'on construit le nom du répertoire mois en fonction du mois
        fn = rep & "Planning " & Format(dateencours, "yyyy-mm-") & "*.xls"    ' on construit le filtre fichier pour les jours du mois
        fn = Dir(fn)    'on prend le premier fichier qui correspond au filtre
        While fn <> ""    'tanr qu'il y a des fichiers
            Set wb = Workbooks.Open(rep & fn)    'on ouvre le classeur
            Set ws = wb.Sheets("nuit")    'onglet à prendre en considération pour la recherche
            'on recherche le nom
            Set re = ws.Range("B1:B100").Find(nom, lookat:=xlWhole, MatchCase:=False)    'max 100 nom sur la feuille nuit à adapter si plus
            If Not re Is Nothing Then    'si nom trouvé
                k = k + 1    'incrémente compteur de ligne résultat
                wso.Cells(k, 2) = Replace(fn, ".xls", "")    'on met lenom du fichier
                wso.Cells(k, 3).Resize(, 2).Value = re.Offset(, 1).Resize(, 2).Value    ' et les autres informations trouvées
            End If
            wb.Close False    'on ferme le classeur
            fn = Dir()    'on prend le classeur suivant
        Wend
    Next mois
    Application.ScreenUpdating = True
    MsgBox "recherche terminée"
End Sub

Bonjour h2so4,

Je n'arrive pas à le faire fonctionner, je pense que tu as dû l'essayer. Je ne vois pas ou je pêche.

dans la ligne rpath = je mets bien mon répertoire

dans la ligne 'tabmois =Split("01_Janvier,02_Fevrier,03_Mars,04_Avril,05_Mai,06_Juin,07_Juillet,08_Aout,09_Septembre,10_Octobre,11_Novembre,12_Decembre", ",") sur le nom des dossiers est écrit 01_Janvier 2017 et toi tu supprimes 2017, normal ?

Bonjour,

bonjour le forum,

Je n'arrive pas à le faire fonctionner, je pense que tu as dû l'essayer. Je ne vois pas ou je pêche.

oui j'ai testé chez moi avec les fichiers que tu as donnés et cela fonctionne. j'ai dû modifier le nom dans la recherche(tu avais mis nom1 et c'est nom 1 qui se trouve dans tes fichiers.

vérifie donc bien le nom introduit, la sélection ne se fera que si le nom dans le fichier est tout à fait identique au nom introduit (la casse n'a pas d'importance)

dans la ligne 'tabmois =Split("01_Janvier,02_Fevrier,03_Mars,04_Avril,05_Mai,06_Juin,07_Juillet,08_Aout,09_Septembre,10_Octobre,11_Novembre,12_Decembre", ",") sur le nom des dossiers est écrit 01_Janvier 2017 et toi tu supprimes 2017, normal ?

oui c'est normal

Bonjour,

cela fonctionne nickel.

Merci pour l'aide apporté.