Die Funktion listet alle Dateien in dem Ordner in dem sie sich befindet auf, öffnet diese und kopert den Wert der Zelle "E32" in eine Liste...

Option Explicit

Sub DatenImport()
Application.ScreenUpdating = 0
 
    'dim
        Dim FileList$(), sPath$
        Dim ErrorMessage$
        Dim WB1 As Object, WB2 As Object
        Dim CRange As Range, PRange As Range
        Dim I&, J&
        Dim WFN$
        
    'set
        WFN = ThisWorkbook.FullName
        sPath = ThisWorkbook.Path
        
        ErrorMessage$ = fListFiles(FileList, sPath, False, "*", "xls")
        If ErrorMessage$ <> "" Then
            MsgBox ErrorMessage$
            Exit Sub
        End If
        
    'aktuelles workbook speichern, neues öffnen
        Set WB1 = ActiveWorkbook
        ReDim ADat(UBound(FileList), 1)
        For I = LBound(FileList) To UBound(FileList)
                
            If Not FileList(I) = WFN Then
                Set WB2 = Workbooks.Open(FileList(I))
                With WB1.Sheets(1)
                .Cells(I + 1 - J, 1).Value = WB2.Sheets(1).Range("E32").Value
                .Cells(I + 1 - J, 2).Value = FileList(I)
                End With
                WB2.Close (False)
            Else: J = J + 1
            End If
            
        Next
        
Application.ScreenUpdating = 1
End Sub

Function fListFiles( _
ByRef List() As String, _
ByVal sPath As String, _
Optional ByVal bSubfolders As Boolean = False, _
Optional ByVal sFilenameFilter As String = "*", _
Optional ByVal sExtensionFilter As String = "*" _
) As String
    
    'dim
        Dim oFS As Object
        Dim OFolder As Object
        Dim oSubfolder As Object
        Dim oFile As Object
        
    'arrays
        Dim Count As Long
        
    'set
        fListFiles = "No Files found"
        If FolderDoesntExist(sPath) Then
            fListFiles = "Folder doesn't exist"
            Exit Function
        End If
        
        Set oFS = CreateObject("Scripting.FileSystemObject")
        Set OFolder = oFS.GetFolder(sPath)

    'search
        For Each oFile In OFolder.Files
            If oFile.Name Like sFilenameFilter & "." & sExtensionFilter Then
        
                ReDim Preserve List(Count)
                List(Count) = oFile.Path
                Count = Count + 1
                fListFiles = vbNullString
                
            End If
        Next
        
        If bSubfolders Then
            For Each oSubfolder In OFolder.SubFolders
                For Each oFile In oSubfolder.Files
                
                    If oFile.Name Like sFilenameFilter & "." & sExtensionFilter Then
                                
                        ReDim Preserve List(Count)
                        List(Count) = oFile.Path
                        Count = Count + 1
                        fListFiles = vbNullString

                    End If
                    
                Next
            Next
        End If
    
    'clear
        Set oFS = Nothing
        Set oFile = Nothing
        Set oSubfolder = Nothing
        Set OFolder = Nothing
   
End Function

Function FolderDoesntExist(sPath$) As Boolean
    
    Dim OFolder As Object
    Dim oFS As Object
    
    On Error GoTo FolderDoesNotExist
    Set oFS = CreateObject("Scripting.FileSystemObject")
    FolderDoesntExist = 0
    Set OFolder = oFS.GetFolder(sPath)
    Set oFS = Nothing
    Set OFolder = Nothing
    Exit Function

FolderDoesNotExist:
    Set oFS = Nothing
    Set OFolder = Nothing
    FolderDoesntExist = 1
End Function