ouvrir les fichiers excel dans un sous repertoire

[bertrand19]

Bonjour,

je dois compilé differents fichiers excel.
ceux-ci se trouvent dans différents sous répertoires

Mon arborescence est la suivante

D:\Compilation\OCT 08\001 REIMS\*.XLS

j'ai pour l'instant le code suivant qui fonctionne si j'indique le chemin du sous répertoire.

Dim File_Is As String
File_Is = Dir("D:\Compilation\OCT 08\001 REIMS\*.XLS")
Do Until File_Is = ""
Workbooks.Open Filename:="D:\Compilation\OCT 08\001 REIMS\" & File_Is


Sheets("feuil1").Select
Range("I6000").Select
Selection.End(xlUp).Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, -8).Select
Application.GoTo Reference:="RC:R13C18"
Selection.Copy

Windows("test.xls").Activate
Sheets("feuil1").Select
Range("I6000").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, -8).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Windows(File_Is).Activate

ActiveSheet.Range("A1").Copy

ActiveWindow.Close

File_Is = Dir
Loop


End Sub


Quelle commande dois je utiliser pour uniquement spécifier à ma macro
"ouvre tous les fichiers excel se trouvant dans le dossier D:\Compilation


Merci par avance

 

[bqtr]

Re : ouvrir les fichiers excel dans un sous repertoire

Bonsoir Bertrand,

Si tu n'es pas sous Excel 2007 essaye ceci :

Sub List_Fichier()

Dim Chemin As String, i As Long

Chemin = "D:\Compilation"
Set FS = Application.FileSearch
      With FS
        .LookIn = Chemin
        .Filename = "*.xls"
        .SearchSubFolders = True
           If .Execute > 0 Then
              For i = 1 To .FoundFiles.Count
                 Workbooks.Open (.FoundFiles(i))
                 ' ton code ici ......
              Next
           End If
      End With
      
End Sub

Ce code va lister tous les fichiers xls et uniquement ceci dans le dossier "Compilation" et ses sous-dossier. Il va ouvrir chaque fichier.

A+

 

[bertrand19]

Re : ouvrir les fichiers excel dans un sous repertoire

Merci BQTR

Ton code fonctionne... Toutes mes fichiers s'ouvrent! c'est juste top!

Mais il me reste un petit probleme...
dans mon code précédent, j'arrivais à revenir sur la fenetre du fichier ouvert grâce à: Windows(File_Is).Activate
pour ensuite fermer la fenetre de manière à ne pas me retrouver avec 300 fichiers excel ouverts.

Avec ce nouveau code, je ne parviens pas à revenir sur le fichier du "chemin",
windows(chemin).activate ne fonctionne pas

Pourrais tu m'indiquer ou se trouve mon erreur????

Sub compilation2()
'
Dim Chemin As String, i As Long

Chemin = "C:\Documents and Settings\BR\Bureau\Compilation"
Set FS = Application.FileSearch
With FS
.LookIn = Chemin
.Filename = "*.xls"
.SearchSubFolders = True
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
Workbooks.Open (.FoundFiles(i))
' ton code ici ......

Sheets(1).Select
Range("I6000").Select
Selection.End(xlUp).Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, -8).Select
Application.GoTo Reference:="RC:R13C18"
Selection.Copy

Windows("macro compilation.xls").Activate
Sheets("feuil1").Select
Range("I6000").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, -8).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Windows(chemin).Activate

ActiveSheet.Range("A1").Copy

ActiveWindow.Close
Next
End If
End With

End Sub

 

[bertrand19]

Re : ouvrir les fichiers excel dans un sous repertoire

Merci!!! c'est bon, j'ai trouvé ma solution.
J'ai lui ai demandé d'activer la deuxième fenetre excel et ensuite de la fermer

Workbooks(2).Activate


Dim Chemin As String, i As Long

Chemin = "D:\compilation\oct 08"
Set FS = Application.FileSearch
With FS
.LookIn = Chemin
.Filename = "*.xls"
.SearchSubFolders = True
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
Workbooks.Open (.FoundFiles(i))
' ton code ici ......

Sheets(1).Select
Range("I6000").Select
Selection.End(xlUp).Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, -8).Select
Application.GoTo Reference:="RC:R13C18"
Selection.Copy

Windows("macro compilationhouse.xls").Activate
Sheets("feuil1").Select
Range("I6000").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, -8).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Workbooks(2).Activate

ActiveSheet.Range("A1").Copy

ActiveWindow.Close

Next
End If
End With

End Sub


Bonne journée à tous

 

[tototiti2008]

Re : ouvrir les fichiers excel dans un sous repertoire

Bonjour à tous,

il faut que tu rajoute une ligne du type

File_Is = right(.foundfiles(i),len(.foundfiles(i))-instrrev("\",.foundfiles(i))

pour pouvoir réutiliser ton code

Windows(File_Is).Activate

ActiveSheet.Range("A1").Copy

ActiveWindow.Close