Recuperer les fichiers dans un repertoire avec une macro

[SEBELEC16]

Bonjour à tous,

Je me permets de solliciter votre aide pour modifier une macro.
Voilà, la macro suivante me permet de lire tous les fichiers se trouvant dans le même répertoire que mon fichier contenant la macro.
Je voudrais pouvoir le mettre dans un dossier différent et aller chercher tous les classeurs à lire dans un autre dossier.

merci d'avance.

Sub essai()
Dim fs, f, f1, fc, s
Dim a(16)
Application.ScreenUpdating = False
specdossier = ActiveWorkbook.Path
fic = ActiveWorkbook.Name
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(specdossier)
Set fc = f.Files
pos = 15
For Each f1 In fc
s = f1.Name
b = Right(s, 3)
If b = "xls" And s <> ActiveWorkbook.Name Then
Workbooks.Open Filename:=specdossier & "\" & s
Sheets("FV").Activate
a(1) = Cells(15, 1)
a(5) = Cells(15, 5)
a(7) = Cells(15, 7)
a(11) = Cells(15, 11)
a(15) = Cells(15, 15)
ActiveWorkbook.Close
Windows(fic).Activate
Sheets("FV").Activate
For u = 1 To 16
Cells(pos, u) = a(u)

Next u
pos = pos + 1
End If
Next
End Sub

PS: CETTE MACRO EST AFFECTE A UN BOUTON MAJ

 

[Paf]

Re : Recuperer les fichiers dans un repertoire avec une macro

Bonjour

si le répertoire où chercher les classeurs est fixe, l'inscrire en dur. par exemple
specdossier="C:\Excel\Productivite"


s'il est variable on peut traiter ainsi:

une fonction ouvre une fenêtre de choix du répertoire de travail

remplacer

specdossier = ActiveWorkbook.Path

par

specdossier = RepIni(ActiveWorkbook.Path)
If specdossier = "" Then Exit Sub

et rajouter le code de la fonction qui ouvre une fenêtre permettant de choisir le répertoire

Function RepIni(Defaut As String)
 Dim fd As FileDialog
 Set fd = Application.FileDialog(msoFileDialogFolderPicker)
 With fd
    .Filters.Clear
    .Title = "Selectionner le répertoire de départ"
    .InitialFileName = Defaut
    If .Show = -1 Then
        RepIni = fd.SelectedItems(1)
    End If
 End With
 Set fd = Nothing
End Function

A+

 

[SEBELEC16]

Re : Recuperer les fichiers dans un repertoire avec une macro

Merci Paf,

Ca fonctionne parfaitement.

Bonne journée.
A+