Ouverture de fichier en boucle

pobrouwers

XLDnaute Occasionnel
Bonjour tt le monde,
Je souhaiterai faire une macro qui me permettrait d'ouvrir en boucle des fichiers xls qui se trouvent dans un répertoire précis et de se placer dans la cellule B24, faire un copier/coller la valeur sur une feuille bien précise (donc ce serait un classeur qui comprendrait les valeurs récupérées des différents fichiers les unes a la suite des autres)
Pour info il y aurait plus ou moins 1500 fichiers dans le repertoire.
Est-ce possible ? Je suppose que oui ;)
Merci
 

Humansoft

XLDnaute Occasionnel
Bonjour pobrouwers, Bonjour le forum,

Voici une apporche pour ouvrir, copier et coller depuis 1 classeur vers X classeurs.

Dans le code, j'ai noté que tu souhaite en ouvrir 1500. Cela risque d'être long.
Fais un essai sur 1 dizaine avant de lancer toute la procédure.
Il faut, avec ce code, que tes fichiers soit nommés 'nom_de_classeur1.xls' à 'nom_de_classeur1500.xls'

Fais un essai et regarde le code. Peut-être que cela te donnear une bonne base de départ.

A+

Vincent

PS: J'ai rajouté une procédure qui vient de ce forum, permettant de vérifier si un classeur est déjà ouvert.
Colle tout ce code dans un module.
'********************************************

Sub Copie_Classeur(ByVal ps_Mois As String)
'
' Macro enregistrée le 29/06/2003 par Humansoft
'
'

'
Dim zs_NomVds, zs_Msg, zs_Tit As String
Dim zi_Nbr as Integer

zs_NomVds = ActiveWorkbook.Name ' Nom du classeur actif
Application.DisplayAlerts = False

For zi_Nbr = 1 to 1500 'Nombre de classeur à ouvrir

zs_PatFic = Application.ActiveWorkbook.Path 'Chemin du classeur à ouvrir
zs_Tit = ActiveWorkbook.Name ' Titre du classeur actif
If IsFileOpen(zs_PatFic + '\\Nom_du_classeur' & Cstr(zi_Nbr) & '.xls') Then
MsgBox 'Le classeur demandé est déjà ouvert!', vbOKOnly, zs_Tit
Else
Workbooks.Open zs_PatFic + '\\Nom_du_classeur' & Cstr(zi_Nbr) & '.xls'
End If

Windows('Nom_du_fichier' & Cstr(zi_Nbr) & '.xls').Activate ' Classeur que l'on vient d'ourir
Sheets('Nom_de_la_feuille').Select 'Feuille où sont les données
Range('B24').select 'Cellule à copier
Selection.Copy
Windows(zs_NomVds).Activate 'Classeur dans lequel on veut copier
Sheets('Nom_de_la_feuille').Select ' Feuille dans laquelle on copie
Range('Cellule').select 'Cellule dans laquelle on colle la copie
ActiveSheet.Paste
Application.CutCopyMode = False

Workbooks('Nom_du_classeur' & Cstr(zi_Nbr) & '.xls').close

Next zi_Nbr
Application.DisplayAlerts = true


End Sub


Function IsFileOpen(filename As String)
' La Fonction ==================================== :
' Merci a Excellabo.com pour cette fonction. Liée à la macro
' elle permet la vérification de fichier déjà ouvert
' Frédéric Sigonneau, El-Joker, Thierry Rural, (N°701)


Dim filenum As Integer, errnum As Integer

On Error Resume Next
filenum = FreeFile()
Open filename For Input Lock Read As #filenum
Close filenum
errnum = Err
On Error GoTo 0
Select Case errnum
Case 0
IsFileOpen = False
Case 70
IsFileOpen = True
Case Else
Error errnum
End Select

End Function
 

excalibur

XLDnaute Impliqué
bonjour pobrouwers , le forum question la valeur que tu recupere elle se trouve toutes sur la meme feuille des fichiers !!! ex: feuil1... je te zip un petit ex si tu peus t en inspire renseigner la cell F1 chemin complet les noms de tous les fichiers s inscivent sur la colonne A traitement ouvrent tous les fichiers un par un recupere la valeur de la cell b24 la recopie a la suite sur la colonne C si tes fichiers ont un nom un peu specifique ex semaine 1 semaine 2 ect.. tu peus modifier la ligne couleur verte salutations
 

excalibur

XLDnaute Impliqué
zip pas passe nouvel essai [file name=boucle.zip size=13353]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/boucle.zip[/file]
 

Pièces jointes

  • boucle.zip
    7.8 KB · Affichages: 32
  • boucle.zip
    7.8 KB · Affichages: 26
  • boucle.zip
    7.8 KB · Affichages: 32

Discussions similaires

Statistiques des forums

Discussions
299 703
Messages
1 978 594
Membres
206 298
dernier inscrit
yannick451