Macro Spider pour collecter des données à partir de divers fichiers Excel

Description

Dans cet article, nous examinerons un exemple de macro capable de rechercher des données dans de nombreux classeurs et d'enregistrer les informations sélectionnées dans un fichier de rapport distinct.

Pour cela, ouvrez votre livre, allez sur Visual Basic Editor (Alt+F11) , ajouter un nouveau module vide (Insert - Module) et copiez-y le texte de cette macro :

Sub Report_file()
'moonexcel.com.ua
Application.ScreenUpdating = False ' désactiver l'actualisation de l'écran 

    Set report = Workbooks("Report.xlsb").Worksheets(1)
    find_field = report.[a1]
    
    ' ouvrir la boîte de dialogue de sélection des fichiers à importer 
    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="All files (*.*), *.*", _
      MultiSelect:=True, Title:=" Sélectionnez les fichiers! ")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox " Aucun fichier sélectionné! "
        Exit Sub
    End If
    
    ' nous parcourons tous les fichiers sélectionnés un par un 
    m = 1
    While m <= UBound(FilesToOpen)
        Set importWB = Workbooks.Open(Filename:=FilesToOpen(m))
        Set importWS = importWB.Worksheets(1)
    
        ' nous battons les cellules"  Chapeaux  " 
        For Each cell2 In report.Range(report.Cells(1, 2), report.Cells(1, report.UsedRange.Columns.Count))
            On Error Resume Next: Err.Clear
            ' chercher du sens dans un livre ouvert 
            tr = importWS.UsedRange.Find(find_field).Row
            tc = importWS.UsedRange.Find(find_field).Column
            x = importWS.Range(importWS.Cells(tr, tc), importWS.Cells(20000, tc)).Find(report.Cells(m + 1, 1).Value).Row
            y = importWS.UsedRange.Find(cell2.Value).Column
            ' transférer les valeurs trouvées dans le fichier de rapport 
            report.Cells(m + 1, cell2.Column).Value = importWS.Cells(x, y).Value
        Next
        
        importWB.Close savechanges:=False
        m = m + 1
    Wend
         
Application.ScreenUpdating = True
End Sub

Après cela, vous pouvez revenir à Excel et exécuter notre macro via le menu Tools - Macro - Macros (Alt+F8) .