Construction Report

Bonjour à tous,

J'espère que vous allez bien

Contexte :

Je vais soumettre d’ici quelques temps des tests à réaliser à divers pays pour que je m’assure que la mise à jour du système que j’ai effectué, n’ait pas endommagé l’aspect fonctionnel. Les différents pays vont tester exactement les mêmes tests.

Ce que je souhaiterais faire :

A partir des fichiers Tests_US, Tests_UK, Tests_Inde, et d'autres pays... j’aimerais consolider sur un seul et unique fichier « DAILY_REPORT» les statut « OK/KO/Postoned/In Progress/TBD (To Be Done)… » de ces tests. Je pourrais le faire à la main, mais il y a plus de 10 pays à traiter et comme je voudrais faire un reporting quotidien il faudrait que ça me prenne le moins de temps possible.

Il faudrait que ce fichier « DAILY_REPORT» vienne récupérer les statuts des différents pays pour me permettre de suivre l’avancée à l'aide d'une macro qui viendrait ouvrir les fichiers, les parcourir, et récupérer les statuts.

Si vous avez des recommandations/amélioration à me soumettre je suis preneur

Vous trouverez en PJ les fichiers avec lesquels je travaillerais

Bonjour,

tu peux facilement consolider les données des différents fichiers, ensuite tu fais soit un TCD soit un filtre automatique.

Option Explicit

Sub collecter()
Dim wbk1 As Workbook, wbk2 As Workbook, ws1 As Worksheet
Dim MonRepertoire, Repertoire As FileDialog, monFichier$, derL%

    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire de stockage des fichiers générés"
    Repertoire.Show
    If Repertoire.SelectedItems.Count = 0 Then Exit Sub
    MonRepertoire = Repertoire.SelectedItems(1) & "\"

    Set wbk1 = ThisWorkbook
    Set ws1 = wbk1.ActiveSheet
    Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Offset(1, 0).ClearContents
    monFichier = Dir(MonRepertoire & "*.xlsx")

    Do While monFichier <> ""
        ws1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
        derL = ws1.Cells(Rows.Count, 1).End(xlUp).Row + 1
        Set wbk2 = Workbooks.Open(MonRepertoire & monFichier)
        wbk2.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Cells.Copy
        ws1.Paste
        Application.DisplayAlerts = False
            wbk2.Close False
        Application.DisplayAlerts = True
        Rows(derL).Delete Shift:=xlUp
        monFichier = Dir
    Loop

    Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Cells(1, 1).Select

End Sub

Hello Steelson,

Merci infiniment pour ta réponse

C'est effectivement une super bonne idée que compiler l'ensemble des fichiers sur un seul document!

Petite question, comme penses-tu que je pourrais retrouver le nom des pays sur mon excel? Histoire que je puisse plus facilement trier et faire mon TCD?

Bien à toi,

Théo

Il faut que j'ajoute le nom du fichier dans la compilation ...

Ah oui! C'est encore une fois une superbe idée ahahaha

Ajout colonne A

Option Explicit

Sub collecter()
Dim wbk1 As Workbook, wbk2 As Workbook, ws1 As Worksheet
Dim MonRepertoire, Repertoire As FileDialog, monFichier$, derL%

    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire de stockage des fichiers générés"
    Repertoire.Show
    If Repertoire.SelectedItems.Count = 0 Then Exit Sub
    MonRepertoire = Repertoire.SelectedItems(1) & "\"

    Set wbk1 = ThisWorkbook
    Set ws1 = wbk1.ActiveSheet
    Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Offset(1, 0).ClearContents
    monFichier = Dir(MonRepertoire & "*.xlsx")

    Do While monFichier <> ""
        ws1.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Select
        derL = ws1.Cells(Rows.Count, 2).End(xlUp).Row + 1
        Set wbk2 = Workbooks.Open(MonRepertoire & monFichier)
        wbk2.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Cells.Copy
        ws1.Paste
        ws1.Range("A" & derL & ":A" & ws1.Cells(Rows.Count, 2).End(xlUp).Row) = wbk2.Name
        Application.DisplayAlerts = False
            wbk2.Close False
        Application.DisplayAlerts = True
        Rows(derL).Delete Shift:=xlUp
        monFichier = Dir
    Loop

    Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Cells(1, 1).Select

End Sub