Macro Lister Fichiers

Bonjour,
La macro ci-dessous permet de lister tous les classeurs d'un répertoire et récupère les données de la cellule A1(Feuil1) de chaque fichier sans l'ouvrir.
Comment l'adapter afin de récuperer les données de plusieurs cellules de chaque fichier ?

Sub chercheFichiersFermesV03()
Dim X As Integer, nbFichiers As Integer, Y As Integer
Dim Tableau() As String
Dim Direction As String

Application.ScreenUpdating = False
Direction = Dir("C:\Documents and Settings\*.xls") 'adapter chemin repertoire

Do While Len(Direction) > 0
nbFichiers = nbFichiers + 1
ReDim Preserve Tableau(1 To nbFichiers)
Tableau(nbFichiers) = Direction
Direction = Dir()
Loop

If nbFichiers > 0 Then
For X = 1 To nbFichiers
If Tableau(X) <> ThisWorkbook.Name Then
Y = Y + 1
With ActiveSheet.Cells(Y, 1)
.Formula = "='C:\Documents and Settings\[" & Tableau(X) & "]Feuil1" & "'!" & "A1"
.Value = .Value
End With
End If
Next X
End If

Application.ScreenUpdating = True
End Sub

Merci Cordialement, Yoyo