Importation onglets

re bonjour

décidement je n'arrete plus

j'ai une macro vraiment top qui importe toutes les 1ere feuil des fichiers excel contenu dans un dossier

le problème c'est qu'elle importe aussi les .xlsm d'où un bug (pas le même nombre de ligne )

est il possible

soit importer uniquement les .xls

ou bien l'ideale transformer les feuil .xlsm en .xls avant importation

de plus n'aurais je pas d'autres surprises si ce dossier contient d'autre format type .csv ou .txt ...

merci de vos conseils

Dim chemin As String, Fichier As String

Dim WbkA As String ' Nom de ce fichier

Dim WbkB As String ' Nom du fichier ouvert

Application.ScreenUpdating = False

WbkA = ThisWorkbook.Name

chemin = Sheets("a").Range("B12").Value & Sheets("a").Range("C12").Value & "\"

Fichier = Dir(chemin & "*.xls*") ' 1er fichier 'Fichier = Dir(chemin & "*.xl*")

Do While (Len(Fichier) > 0)

If Fichier <> ThisWorkbook.Name Then

Workbooks.Open chemin & Fichier

WbkB = ActiveWorkbook.Name

Workbooks(WbkB).Sheets(1).Copy before:=Workbooks(WbkA).Sheets(1)

' ?????????????????????????

If Err.Number = 0 Then

ActiveSheet.Name = WbkB

Else

ActiveSheet.Name = WbkB

End If

Workbooks(WbkB).Close savechanges:=False

'ActiveWorkbook.Close

End If

Fichier = Dir() ' fichier suivant

Loop

End Sub

Bonjour

Essayes en remplaçant cette ligne

Fichier = Dir(chemin & "*.xls*") ' 1er fichier 'Fichier = Dir(chemin & "*.xl*")

Par celle-ci

Fichier = Dir(chemin & "*.xls") ' 1er fichier 'Fichier = Dir(chemin & "*.xl*")

il essai toujours de prendre le fichier xlsm

curieux!!?

Bonjour

Curieux autant qu'étrange, je n'ai pas d'explication juste une astuce pour éviter ces extensions

Surement que quelqu'un connait la solution sur l'emploi de Dir

Sub Test()
Dim chemin As String, Fichier As String
Dim WbkA As String ' Nom de ce fichier
Dim WbkB As String ' Nom du fichier ouvert

  Application.ScreenUpdating = False

  WbkA = ThisWorkbook.Name

  chemin = Sheets("a").Range("B12").Value & Sheets("a").Range("C12").Value & "\"
  Fichier = Dir(chemin & "*.xls") ' 1er fichier 'Fichier = Dir(chemin & "*.xl*")
  Do While (Len(Fichier) > 0)
    If Mid(Fichier, InStrRev(Fichier, ".")) = ".xls" Then
      If Fichier <> ThisWorkbook.Name Then
        Workbooks.Open chemin & Fichier
        WbkB = ActiveWorkbook.Name
        Workbooks(WbkB).Sheets(1).Copy before:=Workbooks(WbkA).Sheets(1)
        ' ?????????????????????????
        If Err.Number = 0 Then
          ActiveSheet.Name = WbkB
        Else
          ActiveSheet.Name = WbkB
        End If
        Workbooks(WbkB).Close savechanges:=False
        'ActiveWorkbook.Close
      End If
    End If
    Fichier = Dir() ' fichier suivant
  Loop
End Sub

dure a expliquer en effet

en tout cas tu as réussi a contourner le problème

super boulot

MERCI