XL 2016 VBA - récupération données dans plusieurs fichiers

[SimonM]

Bonjour à tous,

J'ai un petit problème avec un code VBA. je vous explique le contexte : je dois rechercher des informations de plusieurs cellules différentes, dans plusieurs Sheets différentes, dans un grand nombre de fichiers excel différents. Heureusement, l'emplacement des données est le même pour tous les fichiers. Ces données sont écrites dans un unique fichier excel (BDD) sur une ligne unique à chaque fichier, et je change de ligne à chaque fichier (questionnaire).

Deux questions :

- J'ai un "Variable objet ou variable bloc With non définie" à la ligne "For Each file_questionnaire In FSO.GetFolder ...". Comment éviter ce problème ?
- Mon code fonctionne t-il outre ce problème ?

    Option Explicit
   
    Sub majBDD()
  
        ' // On ajoute Microsoft Scripting Runtime aux références.
      
        Dim FSO         As Scripting.FileSystemObject

        Dim file_questionnaire As Scripting.File
   
   
   
        ' // Déclaration des variables variables
      
        Dim wb_BDD           As Workbook
        Dim wb_questionnaire As Workbook
        Dim X                As Long '// numéro de la ligne libre pour la BDD
        X = 3
   
   
   
        ' // On ouvre le classeur Base De Donnée
        Set wb_BDD = Workbooks.Open("d:\Users\simon.martin.i\Desktop\BDD_questionnaire_2016\BDD2016.xlsx")
   
    
        ' // On ouvre un par un tous les fichiers présents dans le dossier
        For Each file_questionnaire In FSO.GetFolder("d:\Users\simon.martin.i\Desktop\BDD_questionnaire_2016\Questionnaires").Files
   
   
   

          
                ' // On ouvre le classeur questionnaire en lecture seule
                Set wb_questionnaire = Workbooks.Open(file_questionnaire.Path, ReadOnly:=True)
              
                '// On commence la copie des données de la première feuille / sheet du questionnaire
   
   
   
   
   
                ' // On copie les données de la première page
                wb_BDD.Worksheets(1).Cells(X, 1).Value = wb_questionnaire.Worksheets(1).Range("B3").Value
                wb_BDD.Worksheets(1).Cells(X, 2).Value = wb_questionnaire.Worksheets(1).Range("B5").Value
                wb_BDD.Worksheets(1).Cells(X, 3).Value = wb_questionnaire.Worksheets(1).Range("B7").Value
                wb_BDD.Worksheets(1).Cells(X, 4).Value = wb_questionnaire.Worksheets(1).Range("B9").Value
                wb_BDD.Worksheets(1).Cells(X, 5).Value = wb_questionnaire.Worksheets(1).Range("B11").Value
                wb_BDD.Worksheets(1).Cells(X, 6).Value = wb_questionnaire.Worksheets(1).Range("B12").Value
                wb_BDD.Worksheets(1).Cells(X, 7).Value = wb_questionnaire.Worksheets(1).Range("B15").Value
                wb_BDD.Worksheets(1).Cells(X, 8).Value = wb_questionnaire.Worksheets(1).Range("B17").Value
                wb_BDD.Worksheets(1).Cells(X, 9).Value = wb_questionnaire.Worksheets(2).Range("B4").Value
                wb_BDD.Worksheets(1).Cells(X, 10).Value = wb_questionnaire.Worksheets(2).Range("D4").Value
                wb_BDD.Worksheets(1).Cells(X, 11).Value = wb_questionnaire.Worksheets(2).Range("F4").Value
                wb_BDD.Worksheets(1).Cells(X, 12).Value = wb_questionnaire.Worksheets(2).Range("H4").Value
                wb_BDD.Worksheets(1).Cells(X, 13).Value = wb_questionnaire.Worksheets(2).Range("J4").Value
                wb_BDD.Worksheets(1).Cells(X, 14).Value = wb_questionnaire.Worksheets(2).Range("L4").Value
                wb_BDD.Worksheets(1).Cells(X, 15).Value = wb_questionnaire.Worksheets(2).Range("B7").Value
                wb_BDD.Worksheets(1).Cells(X, 16).Value = wb_questionnaire.Worksheets(2).Range("C10").Value
                wb_BDD.Worksheets(1).Cells(X, 17).Value = wb_questionnaire.Worksheets(2).Range("D10").Value
                wb_BDD.Worksheets(1).Cells(X, 18).Value = wb_questionnaire.Worksheets(2).Range("C11").Value
                wb_BDD.Worksheets(1).Cells(X, 19).Value = wb_questionnaire.Worksheets(2).Range("D11").Value
                wb_BDD.Worksheets(1).Cells(X, 20).Value = wb_questionnaire.Worksheets(2).Range("C12").Value
                wb_BDD.Worksheets(1).Cells(X, 21).Value = wb_questionnaire.Worksheets(2).Range("D12").Value
                wb_BDD.Worksheets(1).Cells(X, 22).Value = wb_questionnaire.Worksheets(2).Range("C13").Value
                wb_BDD.Worksheets(1).Cells(X, 23).Value = wb_questionnaire.Worksheets(2).Range("D13").Value
                wb_BDD.Worksheets(1).Cells(X, 24).Value = wb_questionnaire.Worksheets(2).Range("C14").Value
                wb_BDD.Worksheets(1).Cells(X, 25).Value = wb_questionnaire.Worksheets(2).Range("D14").Value
              
   
                ' // indentation du la ligne cible sur la BDD
                X = X + 1
                ' // Fin de l'utilisation des données pour ce questionnaire
                ' // On ferme le classeur questionnaire, toujours sans le modifier
                wb_questionnaire.Close SaveChanges:=False

        Next '// file_questionnaire
   
        ' // On enregistre et on ferme le classeur Base De Donnée
        wb_BDD.Save
        wb_BDD.Close SaveChanges:=False
    End Sub

Merci d'avance 🙂 !

 

[Robert]

Bonjour Simon, bonjour le forum,

Mauvaise déclaration des variables (Scripting.FileSystemObject et Scripting.File)
Essaie comme ça :

Option Explicit

Sub majBDD()
Dim X As Long
Dim CD As Workbook
Dim OB As Worksheet
Dim FSO As Object
Dim GF As Object
Dim FS As Object
Dim F As Object
Dim CS As Workbook
Dim O1 As Worksheet
Dim O2 As Worksheet

X = 3
Set CD = Workbooks.Open("d:\Users\simon.martin.i\Desktop\BDD_questionnaire_2016\BDD2016.xlsx")
Set OB = CD.Worksheets(1)
Set FSO = CreateObject("Scripting.FileSystemObject")
Set GF = FSO.GetFolder("d:\Users\simon.martin.i\Desktop\BDD_questionnaire_2016\Questionnaires")
Set FS = GF.Files
For Each F In FS
    Set CS = Workbooks.Open(F)
    Set O1 = CS.Worksheets(1)
    Set O2 = CS.Worksheets(2)
    OB.Cells(X, 1).Value = O1.Range("B3").Value
    OB.Cells(X, 2).Value = O1.Range("B5").Value
    OB.Cells(X, 3).Value = O1.Range("B7").Value
    OB.Cells(X, 4).Value = O1.Range("B9").Value
    OB.Cells(X, 5).Value = O1.Range("B11").Value
    OB.Cells(X, 6).Value = O1.Range("B12").Value
    OB.Cells(X, 7).Value = O1.Range("B15").Value
    OB.Cells(X, 8).Value = O1.Range("B17").Value
    OB.Cells(X, 9).Value = O2.Range("B4").Value
    OB.Cells(X, 10).Value = O2.Range("D4").Value
    OB.Cells(X, 11).Value = O2.Range("F4").Value
    OB.Cells(X, 12).Value = O2.Range("H4").Value
    OB.Cells(X, 13).Value = O2.Range("J4").Value
    OB.Cells(X, 14).Value = O2.Range("L4").Value
    OB.Cells(X, 15).Value = O2.Range("B7").Value
    OB.Cells(X, 16).Value = O2.Range("C10").Value
    OB.Cells(X, 17).Value = O2.Range("D10").Value
    OB.Cells(X, 18).Value = O2.Range("C11").Value
    OB.Cells(X, 19).Value = O2.Range("D11").Value
    OB.Cells(X, 20).Value = O2.Range("C12").Value
    OB.Cells(X, 21).Value = O2.Range("D12").Value
    OB.Cells(X, 22).Value = O2.Range("C13").Value
    OB.Cells(X, 23).Value = O2.Range("D13").Value
    OB.Cells(X, 24).Value = O2.Range("C14").Value
    OB.Cells(X, 25).Value = O2.Range("D14").Value
    X = X + 1
    CS.Close False
Next F
CD.Save
CD.Close SaveChanges:=False
End Sub