automatiser la copie de données de différents répèrtoires dans une feuille excel

[Dimidim]

Bonjour,



je souhaite automatiser la récupération de données de différents fichiers xlsx des différent sous répertoire :
- résultats:
...............- condition 2 :
.....................................- cl : -1.xlsx
............................................ - 2.xlsx ...
.............. - condition 3 :
.....................................- cl : - 11.xlsx
.............................................- 21.xlsx ...
...............- condition 3 :
.....................................- cl : - 12.xlsx
.............................................- 22.xlsx ...

pour les copier dans une feuille excel tel que :

expl:
donnée1,,donnée2,,donnée3,,...
233525. ,,.365351.,,.354561.,,...
325468. ,,.125468.,,.325457.,,...

j'ai écrit ce code à partir d'un autre code que "Syzygy", un internaute très sympa, m'a gentiment écrit, mais ça ne marche pas. Quelqu'un peut m'expliquer pourquoi et m'aider faire que ça marche ?


Le code:

Public FeuilleDestination As Worksheet   
'Activer la référence "Microsoft scripting runtime" pour que la macro foncitonne   

'Parcours les sous-dossiers inclus dans le répertoire "résultats"   
Sub ListeDossiersResultats()   
    'Adapté de Ole P Erlandsen   
    Application.ScreenUpdating = False   
        Dim Fso As Object, SourceFolder As Object   
    Dim SubFolder As Object   
    Dim NomRep As String   
    Dim NomSousRepComplet As String   
    
    NomRep = "D:\Mes documents\Cours master 1\mémoire2\résultats" 'Nom du répertoire parent   
       
      
    Set Fso = CreateObject("Scripting.FileSystemObject")   
    Set SourceFolder = Fso.GetFolder(NomRep)   
       
    For Each SubFolder In SourceFolder.SubFolders   
    NomSousRepComplet = SubFolder.Path   
         
        SelectionDonneesVariables (NomSousRepComplet)   
                   
    Next SubFolder   
    Application.ScreenUpdating = True   

MsgBox ("Liste terminée")   

End Sub   


    

Sub SelectionDonneesVariables(NomSousRepComplet As String)   

Dim fs, F, f1, s, sf   
Dim i As Long, Fin As Long   
Set FeuilleDestination = ThisWorkbook.Sheets("Traitement")   
    Set fs = CreateObject("Scripting.FileSystemObject")   
    Set F = fs.GetFolder(NomSousRepComplet)   
    Set sf = F.Files   
    For Each f1 In sf   
        If LCase(Right(f1.Name, 3)) = "xlsx" Then   
            Fichier = NomSousRepComplet & "\" & f1.Name   
            Workbooks.Open Filename:=Fichier   
            Range("B3:C3").Select   
            Selection.Copy Destination:=FeuilleDestination.Range("A2:B2")   
            Range("E6").Select   
            Selection.Copy Destination:=FeuilleDestination.Range("C2")   
            Range("K7").Select   
            Selection.Copy Destination:=FeuilleDestination.Range("D2")   
            Range("K4").Select   
            Selection.Copy Destination:=FeuilleDestination.Range("E2")   
            Range("K6").Select   
            Selection.Copy Destination:=FeuilleDestination.Range("F2")   
            Range("K5").Select   
            Selection.Copy Destination:=FeuilleDestination.Range("G2")   
            ActiveWindow.Close SaveChanges:=False   
            'Appel la procédure d'enregistrement   
            Sauv_traitement (Fichier)   
        End If   
    Next   

End Sub   
Sub Sauv_traitement(Fichier)   
'   
' Sauv_traitement Macro   
'   

   Windows("Résumé résultats vérification respect des conditions.xlsm:2").Activate   
       
    Windows("Résumé résultats vérification respect des conditions.xlsm:1").Activate   
    Selection.Copy   
    Windows("Résumé résultats vérification respect des conditions.xlsm:2").Activate   
    ActiveCell.Offset(1, 0).Range("A1").Select   
    ActiveSheet.Paste   
End Sub

Merci

 

[Compte Supprimé 979]

Re : automatiser la copie de données de différents répèrtoires dans une feuille excel

Salut Dimidim,

j'ai écrit ce code à partir d'un autre code que "Syzygy", un internaute très sympa, m'a gentiment écrit, mais ça ne marche pas. Quelqu'un peut m'expliquer pourquoi et m'aider faire que ça marche ?

Il suffit de lui demander, il te répondra gentiment

A+

 

[Dimidim]

Re : automatiser la copie de données de différents répèrtoires dans une feuille excel

c'est ce que j'ai fait, mais finalement j'ai fini par trouver tout seul, donc le sujet est clos.
Mais je ne sais pas comment le signaler comme résolut sur le forum.