Discussion :

[sosolide]

Bonjour, j'ai besoin d'exécuter la macro CouvertureCDS sur tous les fichiers d'un répertoire.
Voilà ce que j'ai fait mais je constate que ça de marche pas...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Sub ouvrir_copier()
Dim CL1 As Workbook, CL2 As Workbook
Dim FL1 As Worksheet, FL2 As Worksheet
Dim Fich As ClFileSearch.ClasseFileSearch, i As Long, Rep As String
 
 
    'Répertoire des fichiers à copier
    Rep = "P:\2.HY\"
'    Set CL1 = ThisWorkbook
 
'    'Ajoute une feuille au classeur destiné à recevoir les données des autres classeurs
'    CL1.Sheets.Add
'    CL1.ActiveSheet.Name = "localisation_Cumul"
 
'    Set FL1 = CL1.ActiveSheet 'Instance le la feuille
 
    'Crée le tableau des fichiers du répertoire
    Set Fich = ClFileSearch.Nouvelle_Recherche
 
    'Ouverture des fichiers du répertoire
    With Fich
        '.strPathName = Rep
        '.strFileType = msoFileTypeExcelWorkbooks
'        If .Execute(SortBy:=msoSortByFileName, _
'            SortOrder:=msoSortOrderAscending) > 0 Then
            For i = 1 To .FoundFilesCount
                Set CL2 = Workbooks.Open(.Files(i).strFileName)
                Debug.Print .Files(i).strFileName
                DoEvents
                CouvertureCDS
 
 
                'Parcours la feuille a copié
'                Set FL2 = Worksheets("Localisation")
'                    'Dernière ligne où coller les données copiées dans FL2
'                    NoLigne = FL1.Range("A1").SpecialCells(xlCellTypeLastCell).Row + 1
'
'                    'Copie de la plage renseignée de chaque feuille du classeur
'                    FL2.Range(FL2.Cells(1, 1), _
'                        FL2.Cells(FL2.Cells(Columns(1).Cells.Count, 1).End(xlUp).Row, _
'                        FL2.Cells(Columns(1).Cells.Count, 1).End(xlUp).Row)).Copy _
'                        FL1.Range("A" & NoLigne)
'                    DoEvents
'                    Set FL2 = Nothing
'                'Next
                CL2.Close False 'fermeture du classeur copié
                DoEvents
                Set CL2 = Nothing
            Next i
'        Else
'            MsgBox "Aucun fichier dans le répertoire " & Rep
'        End If
    End With
End Sub

[Menhir]

Fonction Dir()
https://msdn.microsoft.com/fr-fr/VBA...s/dir-function

[sosolide]

Fonction Dir()
https://msdn.microsoft.com/fr-fr/VBA...s/dir-function

merci, la boucle qui parcours le repertoire est-elle correcte?

[Menhir]

Si la boucle était correcte, je pense que tu n'aurais pas déposé une demande sur ce forum.
Pour le reste, commence déjà par voir mon message précédent.

[kiki29]

Salut, à voir : ceci ou cela etc...