VBA EXCEL: Message d'erreur lors de l'extraction des fichiers

[Aragon10]

Bonjour,

J'utilise une macro qui extrait des valeurs à partir de plusieurs fichiers Excel qui existent dans plusieurs sous dossiers.
Le problème c'est que durant l'extraction un message d'erreur apparait et qui indique ("l'indice n'appartient pas à la selection") et après avoir cliquer sur OK elle change completement de dossier et ignore le reste des fichiers.par exemple sur le dossier "Mars" lorsque le message d'erreur apparait sur le premier fichier (01/03/2015) la macro ne continu pas à extraire les info du reste des fichiers de Mars (02/03..31/03/2015)mais elle saute vers le dossier de Avril. je ne sais pas pourquoi elle ne continu pas à fouiller le reste des fichiers du mois de Mars.

ci-dessous mon code:

Sub Facture()
    Dim nbLignes As Long
    Dim Chemin
    nbLignes = Sheets("Facture").Cells(Rows.Count, "A").End(xlUp).Row
 

    Chemin = BrowseForFolder("C:\Users\seb\Desktop")  'Changer le C pour autre chose si nécessaire
   
    
    ImportFiles Chemin   'Changer au besoin
    
    Sheets("Facture").Sort.SortFields.Add Key:=Range("A30:A" & nbLignes), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Sheets("Facture").Sort
        .SetRange Range("A30:AN" & nbLignes)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
   
    MsgBox "Terminé"
    
End Sub
 
Sub ImportFiles(varPath As Variant)
    Dim nbLignes As Long
    Dim varFile As Variant
    Dim objColl As Collection
 
    On Error GoTo Erreur
 
    Set objColl = New Collection
 
    If Right(varPath, 1) <> "\" Then varPath = varPath & "\"
 
    varFile = Dir(varPath, vbDirectory + vbArchive)
    Do While varFile <> ""
        'Stocke le répertoire
        If GetAttr(varPath & varFile) = vbDirectory Then
            If Left(varFile, 1) <> "." Then
                objColl.Add varPath & varFile
            End If
 
        'Travailler avec le fichier
        ElseIf LCase(Right(varFile, 3)) = "xls" Or LCase(Right(varFile, 4)) = "xlsx" Or LCase(Right(varFile, 4)) = "xlsm" Then
            'Détermine la première ligne vide du classeur Résultats
            nbLignes = ThisWorkbook.Sheets("Facture").Cells(Rows.Count, "A").End(xlUp).Row + 1
 
 
            'Ouvrir le fichier, copier les données et le fermer
            Application.DisplayAlerts = False
            Workbooks.Open varPath & varFile, , True
            Application.DisplayAlerts = False
            
                                                                                
             ActiveWorkbook.Sheets("Tableau Feuil1").Range("D11").Copy ThisWorkbook.Sheets("Facture").Range("B" & nbLignes)
            ActiveWorkbook.Sheets("Tableau Feuil1").Range("F11").Copy ThisWorkbook.Sheets("Facture").Range("C" & nbLignes)
            ActiveWorkbook.Sheets("Tableau Feuil1").Range("D12").Copy ThisWorkbook.Sheets("Facture").Range("D" & nbLignes)
                                      
 
            ActiveWorkbook.Close False
        End If
        varFile = Dir
    Loop
 
    For Each varFile In objColl
        ImportFiles varFile
    Next
 
    Set objColl = Nothing
 
    Exit Sub
 
Erreur:
    MsgBox Err.Number & vbCrLf & Err.Description
End Sub



Function BrowseForFolder(Optional OpenAt As Variant) As Variant
    Dim ShellApp As Object
     
    Set ShellApp = CreateObject("Shell.Application"). _
        BrowseForFolder(0, "Please choose a folder", 0, CVar(OpenAt))
     
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
     
    Set ShellApp = Nothing
     
    Select Case Mid(BrowseForFolder, 2, 1)
        Case Is = ":"
            If Left(BrowseForFolder, 1) = ":" Then GoTo Erreur
        Case Is = "\"
            If Not Left(BrowseForFolder, 1) = "\" Then GoTo Erreur
        Case Else
            GoTo Erreur
    End Select
     
    Set ShellApp = Nothing
     
    Exit Function
     
Erreur:
    BrowseForFolder = False
     
End Function

Merci pour votre réponse.

 

[Dranreb]

Re : VBA EXCEL: Message d'erreur lors de l'extraction des fichiers

Bonjour.

C'est normal: vous sortez de la procédure à la moindre erreur sans pouvoir savoir où elle se produisait.
Je vous conseille de mettre en commentaire le On Error GoTo Erreur, et de mettre des On Error Resume Next devant les instruction que vous aurez repéré comme pouvant provoquer une erreur, et de les gérer.

 

[Aragon10]

Re : VBA EXCEL: Message d'erreur lors de l'extraction des fichiers

Bonsoir,

Merci beaucoup pour ton aide ;-)