Import

bonjour ,

je rame

je n'arrive pas a indiquer le chemin d'un dossier et a importer tous les .xls qu'il contient

je voudrais choisir un dossier grace a une boite de dialogue (je pense qu'il faudrait l'instruction

Application.FileDialog(msoFileDialogFolderPicker)

mais je n'y arrive pas , si quelqu'un a une idée

Dim chemin As String, Fichier As String
Dim WbkA As String ' Nom de ce fichier
Dim WbkB As String ' Nom du fichier ouvert
Dim WbkC As String

  Application.ScreenUpdating = False

  WbkA = ThisWorkbook.Name

  chemin = Sheets("a").Range("B12").Value
  Fichier = Dir(chemin & "*.xls")
  Do While (Len(Fichier) > 0)
    If Mid(Fichier, InStrRev(Fichier, ".")) = ".xls" Then
      If Fichier <> ThisWorkbook.Name Then
        Workbooks.Open chemin & Fichier
        WbkB = ActiveWorkbook.Name
        WbkC = ActiveWorkbook.Name
        Workbooks(WbkB).Sheets(1).Copy before:=Workbooks(WbkA).Sheets(1)

If Len(WbkB) > 28 Then WbkC = Left(WbkB, 12) & " " & Right(WbkB, 5)
ActiveSheet.Name = WbkC

If Len(WbkB) <= 28 Then ActiveSheet.Name = WbkB

 Workbooks(WbkB).Close SaveChanges:=False
 End If
 End If
 Fichier = Dir() ' fichier suivant
 Loop

Bonsoir,

Dim chemin As String, Fichier As String
Dim WbkA As String ' Nom de ce fichier
Dim WbkB As String ' Nom du fichier ouvert
Dim WbkC As String

  Application.ScreenUpdating = False

  WbkA = ThisWorkbook.Name

  Set fd = Application.FileDialog(msoFileDialogFolderPicker)
  If fd.Show = -1 Then
  chemin = fd.SelectedItems(1) & "\"
  else
  exit sub
  End If
  Fichier = Dir(chemin & "*.xls*")
  Do While (Len(Fichier) > 0)
    If Mid(Fichier, InStrRev(Fichier, ".")) = ".xls" Then
      If Fichier <> ThisWorkbook.Name Then
        Workbooks.Open chemin & Fichier
        WbkB = ActiveWorkbook.Name
        WbkC = ActiveWorkbook.Name
        Workbooks(WbkB).Sheets(1).Copy before:=Workbooks(WbkA).Sheets(1)

If Len(WbkB) > 28 Then WbkC = Left(WbkB, 12) & " " & Right(WbkB, 5)
ActiveSheet.Name = WbkC

If Len(WbkB) <= 28 Then ActiveSheet.Name = WbkB

 Workbooks(WbkB).Close SaveChanges:=False
 End If
 End If
 Fichier = Dir() ' fichier suivant
Loop

parfait h2so4

merci