vba boucle pour compiler la Feuill1 de tous les fichiers xls d'un répertoire

[perdinch]

Bonjour,

Avec vba , je souhaite compiler dans un classeur la "feuill1" à partir la cellule A6
de tous les fichiers xls
d'un même répertoire nommé "conso" .


Merci de votre aide

 

[Roland_M]

Re : vba boucle pour compiler la Feuill1 de tous les fichiers xls d'un répertoire

Bonjour,

exemple de code, à toi de voir pour adapter !? c'est assez simple !

Sub LoadFichUnRep()
Dim Rep$, Fichier$, NbrFich As Integer
'load rep
With Application.FileDialog(msoFileDialogFolderPicker)
  .ButtonName = "OK"
  .InitialFileName = ThisWorkbook.Path & " \ "
  .Title = "Sélectionnez un dossier"
  .Show
  If .SelectedItems.Count > 0 Then
      Rep = .SelectedItems(1): If Right(Rep, 1) <> "\" Then Rep = Rep & "\"
  End If
End With

'ou load rep autre
'Dim ObjShell As Object, ObjFolder As Object, Rep$
'Set ObjShell = CreateObject("Shell.Application")
'Set ObjFolder = ObjShell.BrowseForFolder(0, "Sélectionnez un dossier", &H201&)
'If Not ObjFolder Is Nothing Then
'   Rep = ObjFolder.Items.Item.Path: If Right(Rep, 1) <> "\" Then Rep = Rep & "\"
'End If
'Set ObjShell = Nothing: Set ObjFolder = Nothing

'load fichier
If Rep = "" Then Exit Sub
Cells.Clear: NbrFich = 0
Fichier = Dir(Rep & "*.*") '<<<<<<<<<<<<< ici mettre l'extention
Do While (Len(Fichier$) > 0)
   NbrFich = NbrFich + 1
   Cells(NbrFich, 1) = Fichier '<<<< ici voir l'emplacement sur feuille, remplacer NbrDeFich par Lig
   Fichier = Dir() 'suite
Loop
End Sub