Bonjour,  
j'ai le répertoire C:\MESDOCUMENTS-F\CCOB1 qui contient plusieurs centaines de classeurs excel contenant chacun quelques feuilles.Sur la 1ère feuille de chaque classeur, j'ai besoin de récupérer les données de la celllule D4,F4,E9,F50 à F53 de les copier dans une feuille d'un nouveau classeur pour en faire un tableau récapitulatif comme suit  
 
nom du classeur D4 F4 E9 F50 F51 F52 F53  
Classeur 1        
Classeur 2        
etc  
 
je n'arrive pas à écrire le code d'une macro qui ouvre chaque classeur de ce répertoire , récupére les données voulues, les recopie sur la nouvelle feuille, referme le classeur, ouvre le suivant, récupére les données, le referme et ainsi de suite jusqu'au dernier classeur et affiche le tableau récapitulatif.  
Quelqu'un pourrait il m'aider?  
Merci d'avance  
jpha
 

ouvrir tout les fichiers d'un repertoire  source (exelabo)
 
Dim F
With Application.FileSearch
.NewSearch
.LookIn = "C:\Temp"
.Execute
On Error Resume Next
For Each F In .FoundFiles
Workbooks.Open F
Next F
End With
 
puis je te passe les commande classic de copie de cellule ..
pour chaque activeworkbook  copie des cellules , fermeture ...
 
si ca peux aider ...
 
 

cela ne m'aide pas beaucoup mais un grand merci tout de même  
jpha

ca devrait pourtant
 
je te conseille de faire ce que tu veux en l'enregistrant a l'aide de outil/macro/enregistre macro
 
et puis kan tu auras une base sur laquelle travailler ca ira mieux

Dim F
With Application.FileSearch
.NewSearch
.LookIn = "C:\Temp"
.Execute
On Error Resume Next
i=1
For Each F In .FoundFiles
Workbooks.Open F
workbooks(F).sheet(1).range("D4" ).copy(workbook("recap.xls" ).sheets("feuillerecap" ).cells(i+1,1))
......(6 lignes de plus)
workbooks(F).close
i=i+1
Next F

cela ne marche ( 2 problèmes)
1) blocage sur Workbook (avec message sub ou function non définie):j'ai mis alors ThisWorkbook , puis ensuite  
2) erreur 445 (cet objet ne gère pas cette action)

Voir et adapter
http://forum.hardware.fr/hfr/Progr [...] 0232_1.htm
http://forum.hardware.fr/hfr/Progr [...] m#t1750135
http://forum.hardware.fr/hfr/Progr [...] m#t1570350
http://forum.hardware.fr/hfr/Progr [...] 4866_1.htm

merci 86 vomito33: j'ai repris ton idée et modifier le code car filesearch n'est  plus géré (a priori) par excel 2007 et maintenant je bloque au niveau de WorkBook avec un message d'erreur (sub ou function non définie)
peux tu m'expliquer ?
 
Sub test()
    Dim Chemin As String, Fichier As String  
    Chemin = "C:\test5\"
    Fichier = Dir(Chemin & "*.xls" )
    Do While Fichier <> ""
        Workbooks.Open Chemin & Fichier
        Fichier = Dir
        i = 1
         
            Workbooks(Fichier).Sheet(1).Range("D4" ).Copy (Workbook("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i + 1, 1))
            Workbooks(Fichier).Sheet(1).Range("F4" ).Copy (Workbook("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i + 1, 2))
            Workbooks(Fichier).Sheet(1).Range("E9" ).Copy (Workbook("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i + 1, 3))
            Workbooks(Fichier).Sheet(1).Range("F50" ).Copy (Workbook("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i + 1, 4))
            Workbooks(Fichier).Sheet(1).Range("F51" ).Copy (Workbook("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i + 1, 5))
            Workbooks(Fichier).Sheet(1).Range("F52" ).Copy (Workbook("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i + 1, 6))
            Workbooks(Fichier).Sheet(1).Range("F53" ).Copy (Workbook("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i + 1, 7))
            Workbooks(Fichier).Close
            i = i + 1
    Loop
End Sub

avec un "s" c'est mieux
par contre ton i=1 et i=i+1 sont pas trés bien placé

et puis la ligne

doit etre transforme en:

je sais pas ce que j'avais hier mai faut que j'arrete la fumette
 
comme cela ca marche
 

 
il faut activer (si c pas fait) dans outil/reference/microsoft scripting runtime

super :cela fonctionne  sauf que   dans mon exemple j'ai omis de préciser que la cellule A1 contient une formule et donc la macro me récupère un #REF! au lieu de la valeur de A1 et il faut faire un collage special pour récupérer uniquement la valeur.peux tu me l'écrire en VBA?
merci
jpha

Sub test()
Dim Chemin As String, Fichier As String
Chemin = "C:\test5\"
Fichier = Dir(Chemin & "*.xls" )
i = 1
Set fso = New Scripting.FileSystemObject
Set DossierSource = fso.GetFolder(Chemin)
 
For Each F In DossierSource.Files
fbis = Mid(F, 10, Len(F) - 9)
Workbooks.Open Chemin & fbis
Workbooks(fbis).Activate
Workbooks(fbis).Sheets(1).Range("D4" ).Copy (Workbooks("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i, 1))
Workbooks(fbis).Sheets(1).Range("F4" ).Copy (Workbooks("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i, 2))
Workbooks(fbis).Sheets(1).Range("E9" ).Copy (Workbooks("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i, 3))
Workbooks(fbis).Sheets(1).Range("F50" ).Copy (Workbooks("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i, 4).Paste.Value)
Workbooks(fbis).Sheets(1).Range("F51" ).Copy (Workbooks("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i, 5))
Workbooks(fbis).Sheets(1).Range("F52" ).Copy (Workbooks("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i, 6))
Workbooks(fbis).Sheets(1).Range("F53" ).Copy (Workbooks("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i, 7).Paste.Value)
Workbooks(fbis).Close
i = i + 1
Next
 
End Sub
 
dans les 2 cellules F50 et F53, je n'arrive pas à écrire proprement le code d'un PasteSpecial car le copy que tu m'as donné me récupére un #REF! +  le format. Et l'enregistreur de macro me donne un code pas très "propre".Je veux donc récupérer seulement la valeur  de ces celllules ( sans  le format et la formule) et l'écrire "proprement". Ce que j'ai écrit pour ces cellules F50 et F53 me donne une erreur 438 (propriété ou méthode non gérée par cet objet)  
merci à toi  86vomito33 de me dépanner
jpha

merci 86vomito33  
ce code fonctionne parfaitement (XP EXCEL 2007) et je le donne pour d'autres qui pourraient avoir le même cas de figue à traiter.
Il récupére donc les valeurs de plusieurs cellules dans différents classeurs (ici +- 250) et en fait une récap dans un autre
mon probléme est donc résolu  
La seule chose qui reste, c'est que sur les cellules D4,F4,F51 et F52, il récupère aussi le quadrillage alors que pourtant , je n'ai indiqué que la Value. J'avoue ne pas comprendre et si tu as une idée, je suis preneur
encore mille merci à toi à toute l'équipe
jpha
 
Sub test()
Dim Chemin As String, Fichier As String
Chemin = "C:\test5\"
Fichier = Dir(Chemin & "*.xls" )
i = 1
Set fso = New Scripting.FileSystemObject
Set DossierSource = fso.GetFolder(Chemin)
 
For Each F In DossierSource.Files
    fbis = Mid(F, 10, Len(F) - 9)
    Workbooks.Open Chemin & fbis
    Workbooks(fbis).Activate
       
        'Workbooks(fbis).Sheets(1).Range("D4" ).Copy (Workbooks("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i, 1))
        Workbooks("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i, 1) = Workbooks(fbis).Sheets(1).Range("D4" ).Value
 
        'Workbooks(fbis).Sheets(1).Range("F4" ).Copy (Workbooks("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i, 2))
        Workbooks("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i, 2) = Workbooks(fbis).Sheets(1).Range("F4" ).Value
 
        'Workbooks(fbis).Sheets(1).Range("E9" ).Copy (Workbooks("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i, 3))
        Workbooks("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i, 3) = Workbooks(fbis).Sheets(1).Range("E9" ).Value
 
        'Workbooks(fbis).Sheets(1).Range("F50" ).Copy (Workbooks("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i, 4))
        Workbooks("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i, 4) = Workbooks(fbis).Sheets(1).Range("F50" ).Value
 
        'Workbooks(fbis).Sheets(1).Range("F51" ).Copy (Workbooks("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i, 5))
        Workbooks("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i, 5) = Workbooks(fbis).Sheets(1).Range("F51" ).Value
 
        'Workbooks(fbis).Sheets(1).Range("F52" ).Copy (Workbooks("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i, 6))
        Workbooks("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i, 6) = Workbooks(fbis).Sheets(1).Range("F52" ).Value
 
        'Workbooks(fbis).Sheets(1).Range("F53" ).Copy (Workbooks("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i, 7))
        Workbooks("01-RECAP-TEST5.xls" ).Sheets("feuillerecap" ).Cells(i, 7) = Workbooks(fbis).Sheets(1).Range("F53" ).Value
         
     Workbooks(fbis).Close
i = i + 1
Next
 
End Sub

Bonjour à tous,
 
merci pour toutes ces infos.
J'essaye de faire la même chose, je me suis alors inspiré du programme précédent.
Cependant, lors de l'exécution il bloque à ce niveau la : Workbooks.Open Chemin & fbis  (avec erreur '1004' : La méthode 'Open' de l'objet 'Workbooks' a échoué)
 
Je n'arrive pas à débloquer le problème.
 
si quelqu'un peut m'aider  
 
voici le code :
Sub test()
Dim Chemin As String, Fichier As String
Chemin = "C:\Test...etc"
Fichier = Dir(Chemin & "*.xls" )
i = 1
Dim fso As Object
 
Set fso = CreateObject("Scripting.FileSystemObject" )
Set DossierSource = fso.GetFolder(Chemin)
 
For Each F In DossierSource.Files
    fbis = Mid(F, 10, Len(F) - 9)
    Workbooks.Open Chemin & fbis
    Workbooks(fbis).Activate
         
        'Workbooks(fbis).Sheets(1).Range("M2" ).Copy (Workbooks("Pont-GDA.xls" ).Sheets("pont gda" ).Cells(i, 1))
        Workbooks("Pont-GDA.xls" ).Sheets("pont gda" ).Cells(i, 1) = Workbooks(fbis).Sheets(1).Range("M2" ).Value