récupérer une plage de données de fichiers d'1 mm repertoire

[polpoye]

bonjour a tous,

1°/ grace a vous j'ai tout d'abord eu une bonne note a ma soutenance de stage que j'ai fait sous VB... merci donc a ceux qui ont contribué de pres ou de loin a ce succes.

2°/ je dois ouvrir 200 fichiers pour comparer des valeurs

*Je souhaiterai récuperer les données de A1 a A10 de chaque fichier excel du repertoire "bureau" dans un fichier "test.xls" dans la colonne A.
une fois recuperer je voudrais comparer la colonne A(lign) et B(lign) (pré-saisie) et mettre dans C(lign) la valeur de B(lign) en rouge si A(lign) different de B(lign) (valeur de chaque ligne)

je sais que c'est un probleme récurrent mais tellement chiant quand on y arrive pas.

voila ce que j'ai fait mais c'est pas terrible...
*****
Sub listefichier()
On Error Resume Next
Set fs = Application.FileSearch
With fs
.LookIn = "C:\windows\bureau"
.Filename = "*.xls"
If .Execute > 0 Then
'MsgBox "il y a " & .FoundFiles.Count & " fichier(s) trouvés."
For i = 1 To .FoundFiles.Count
fichier = fs.FoundFiles(i)
//me donne le nomAbsolu ( je souhaiterai le nomRelatif)

'MsgBox ("" & fichier)
Next i
Else
MsgBox "pas de fichiers Excel présents dans ce repertoire."
End If
End With
End Sub

********

merci de votre aide.

 

[Rolilandon]

Salut polpoye
voila du code qui semble s'approcher de ce que tu cherches


Sub BalayageFichier()
Dim Cellule As Variant
Dim NomFichier As String, Chemin As String
Dim Deplacement As Integer
Const NbCellule As Integer = 3, FichierComp As String = "test.xls"
Deplacement = 0
Chemin = "E:\test\excel\toto"
NomFichier = Dir("*.XLS")
If NomFichier = FichierComp Then NomFichier = Dir()
Do
Workbooks.OpenText Filename:=Chemin & "\" & NomFichier, _
Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:= _
Array(0, 1)
Range("A1:A3").Copy
Workbooks(fichiercomp).Activate
Range("A1").Offset(Deplacement, 0).PasteSpecial
Deplacement = Deplacement + NbCellule
Workbooks(NomFichier).Close
NomFichier = Dir()
If NomFichier = FichierComp Then NomFichier = Dir()
Loop Until NomFichier = ""
Workbooks(FichierComp).Save
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
For Each Cellule In Selection
Cellule.Offset(0, 2) = Cellule.Offset(0, 1).Value
If Cellule.Value <> Cellule.Offset(0, 1).Value Then _
Cellule.Offset(0, 2).Font.ColorIndex = 3
Next
End Sub

bon courage