Je dois réaliser une base de données à partir de differents fichier Excel (tous les fichier sont de la même forme).
Tous ces fichiers se trouvent dans des sous repertoires qui se trouvent dans un seul gros repertoire. (Repertoire_principalSous_repertoireFichier.xls)
J'ai donc besoin d'une macro qui va ouvrir le "Repertoire_principa"l , ouvrir chaque "Sous_repertoire" en automatique et ouvrir le "Fichier.xls "se trouvant dans le repertoire, recupèrer certaines données dans le fichier ( j'ai déja une macro qui permet de récupèrer ces données) les stocker dans un fichier Excel "Synthèse" et ainsi de suite..avec tous les fichiers Excel.
Je ne sais pas si j'ai été très clair, alors si vous avez besoin de plus de précisions n'hesitez pas.
Merci d'avance pour l'attention que vous accorderez à mon petit problème!
Je dois réaliser une base de données à partir de differents fichier Excel (tous les fichier sont de la même forme).
Tous ces fichiers se trouvent dans des sous repertoires qui se trouvent dans un seul gros repertoire. (Repertoire_principalSous_repertoireFichier.xls)
J'ai donc besoin d'une macro qui va ouvrir le "Repertoire_principa"l , ouvrir chaque "Sous_repertoire" en automatique et ouvrir le "Fichier.xls "se trouvant dans le repertoire, recupèrer certaines données dans le fichier ( j'ai déja une macro qui permet de récupèrer ces données) les stocker dans un fichier Excel "Synthèse" et ainsi de suite..avec tous les fichiers Excel.
Je ne sais pas si j'ai été très clair, alors si vous avez besoin de plus de précisions n'hesitez pas.
Merci d'avance pour l'attention que vous accorderez à mon petit problème!
J'ai remplacé Worksheets par Workbook :
With .Workbook.Worksheets("Liste FT")
Quand je lance la macro à partir d'un bouton, elle s'enclenche mais je n'ai aucune ouverture de repertoire ni rien..
Le mardi 28 Janvier 2014 à 11:58 par Modjow :
Bonjour,
Voici mon problème :
Je dois réaliser une base de données à partir de
differents fichier Excel (tous les fichier sont de la même forme).
Tous ces fichiers se trouvent dans des sous repertoires qui se trouvent dans un
seul gros repertoire. (Repertoire_principalSous_repertoireFichier.xls)
J'ai donc besoin d'une macro qui va ouvrir le "Repertoire_principa"l
, ouvrir chaque "Sous_repertoire" en automatique et ouvrir le
"Fichier.xls "se trouvant dans le repertoire, recupèrer
certaines données dans le fichier ( j'ai déja une macro qui
permet de récupèrer ces données) les stocker dans un
fichier Excel "Synthèse" et ainsi de suite..avec tous les
fichiers Excel.
Je ne sais pas si j'ai été très clair, alors si vous avez
besoin de plus de précisions n'hesitez pas.
Merci d'avance pour l'attention que vous accorderez à mon petit
problème!
J'ai remplacé Worksheets par Workbook :
With .Workbook.Worksheets("Liste FT")
Quand je lance la macro à partir d'un bouton, elle s'enclenche mais je n'ai aucune ouverture de repertoire ni rien..
Je dois réaliser une base de données à partir de differents fichier Excel (tous les fichier sont de la même forme).
Tous ces fichiers se trouvent dans des sous repertoires qui se trouvent dans un seul gros repertoire. (Repertoire_principalSous_repertoireFichier.xls)
J'ai donc besoin d'une macro qui va ouvrir le "Repertoire_principa"l , ouvrir chaque "Sous_repertoire" en automatique et ouvrir le "Fichier.xls "se trouvant dans le repertoire, recupèrer certaines données dans le fichier ( j'ai déja une macro qui permet de récupèrer ces données) les stocker dans un fichier Excel "Synthèse" et ainsi de suite..avec tous les fichiers Excel.
Je ne sais pas si j'ai été très clair, alors si vous avez besoin de plus de précisions n'hesitez pas.
Merci d'avance pour l'attention que vous accorderez à mon petit problème!
J'ai remplacé Worksheets par Workbook :
With .Workbook.Worksheets("Liste FT")
Quand je lance la macro à partir d'un bouton, elle s'enclenche mais je n'ai aucune ouverture de repertoire ni rien..
MichD
Il y a une erreur de copie, désolé!
Ceci : '------------------------------------ Do While MonFichier <> "" With Dest With .Worksheets.Worksheets("Liste FT") If Not IsEmpty(.UsedRange) Then
'------------------------------------
La ligne : With .Worksheets.Worksheets("Liste FT")
devrait s'écrire :
With .Worksheets("Liste FT")
Il y a une erreur de copie, désolé!
Ceci :
'------------------------------------
Do While MonFichier <> ""
With Dest
With .Worksheets.Worksheets("Liste FT")
If Not IsEmpty(.UsedRange) Then
'------------------------------------
La ligne : With .Worksheets.Worksheets("Liste FT")
Ceci : '------------------------------------ Do While MonFichier <> "" With Dest With .Worksheets.Worksheets("Liste FT") If Not IsEmpty(.UsedRange) Then
'------------------------------------
La ligne : With .Worksheets.Worksheets("Liste FT")
devrait s'écrire :
With .Worksheets("Liste FT")
modjow
Le mardi 28 Janvier 2014 à 11:58 par Modjow :
Bonjour,
Voici mon problème :
Je dois réaliser une base de données à partir de differents fichier Excel (tous les fichier sont de la même forme).
Tous ces fichiers se trouvent dans des sous repertoires qui se trouvent dans un seul gros repertoire. (Repertoire_principalSous_repertoireFichier.xls)
J'ai donc besoin d'une macro qui va ouvrir le "Repertoire_principa"l , ouvrir chaque "Sous_repertoire" en automatique et ouvrir le "Fichier.xls "se trouvant dans le repertoire, recupèrer certaines données dans le fichier ( j'ai déja une macro qui permet de récupèrer ces données) les stocker dans un fichier Excel "Synthèse" et ainsi de suite..avec tous les fichiers Excel.
Je ne sais pas si j'ai été très clair, alors si vous avez besoin de plus de précisions n'hesitez pas.
Merci d'avance pour l'attention que vous accorderez à mon petit problème!
Il me semble que j'ai un problème lorsque je défini mon répértoire.
Je remplace
'Répertoire de départ à définir... Répertoire = "C:UsersTon profilDocuments"
Par
'Répertoire de départ à définir... Répertoire = "X:PUBLICFABGAMMESBUS"
Mais j'ai une erreur comme quoi le chemin d'accès est introuvable alors que l'adresse du répertoire est la bonne. C'est le bon format d'écriture?
Le mardi 28 Janvier 2014 à 11:58 par Modjow :
Bonjour,
Voici mon problème :
Je dois réaliser une base de données à partir de
differents fichier Excel (tous les fichier sont de la même forme).
Tous ces fichiers se trouvent dans des sous repertoires qui se trouvent dans un
seul gros repertoire. (Repertoire_principalSous_repertoireFichier.xls)
J'ai donc besoin d'une macro qui va ouvrir le "Repertoire_principa"l
, ouvrir chaque "Sous_repertoire" en automatique et ouvrir le
"Fichier.xls "se trouvant dans le repertoire, recupèrer
certaines données dans le fichier ( j'ai déja une macro qui
permet de récupèrer ces données) les stocker dans un
fichier Excel "Synthèse" et ainsi de suite..avec tous les
fichiers Excel.
Je ne sais pas si j'ai été très clair, alors si vous avez
besoin de plus de précisions n'hesitez pas.
Merci d'avance pour l'attention que vous accorderez à mon petit
problème!
Il me semble que j'ai un problème lorsque je défini mon répértoire.
Je remplace
'Répertoire de départ à définir...
Répertoire = "C:UsersTon profilDocuments"
Par
'Répertoire de départ à définir...
Répertoire = "X:PUBLICFABGAMMESBUS"
Mais j'ai une erreur comme quoi le chemin d'accès est introuvable alors que l'adresse du répertoire est la bonne. C'est le bon format d'écriture?
Je dois réaliser une base de données à partir de differents fichier Excel (tous les fichier sont de la même forme).
Tous ces fichiers se trouvent dans des sous repertoires qui se trouvent dans un seul gros repertoire. (Repertoire_principalSous_repertoireFichier.xls)
J'ai donc besoin d'une macro qui va ouvrir le "Repertoire_principa"l , ouvrir chaque "Sous_repertoire" en automatique et ouvrir le "Fichier.xls "se trouvant dans le repertoire, recupèrer certaines données dans le fichier ( j'ai déja une macro qui permet de récupèrer ces données) les stocker dans un fichier Excel "Synthèse" et ainsi de suite..avec tous les fichiers Excel.
Je ne sais pas si j'ai été très clair, alors si vous avez besoin de plus de précisions n'hesitez pas.
Merci d'avance pour l'attention que vous accorderez à mon petit problème!
Il me semble que j'ai un problème lorsque je défini mon répértoire.
Je remplace
'Répertoire de départ à définir... Répertoire = "C:UsersTon profilDocuments"
Par
'Répertoire de départ à définir... Répertoire = "X:PUBLICFABGAMMESBUS"
Mais j'ai une erreur comme quoi le chemin d'accès est introuvable alors que l'adresse du répertoire est la bonne. C'est le bon format d'écriture?
MichD
Remplace ceci : '-------------------------------------------- 'Répertoire de départ à définir... Répertoire = "X:PUBLICFABGAMMESBUS" '--------------------------------------------
Par
ChDrive "X" ChDir "X:PUBLICFABGAMMESBUS"
Ne pas oublier d'inscrire le "" à la fin du chemin où sont tes fichiers
Remplace ceci :
'--------------------------------------------
'Répertoire de départ à définir...
Répertoire = "X:PUBLICFABGAMMESBUS"
'--------------------------------------------
Par
ChDrive "X"
ChDir "X:PUBLICFABGAMMESBUS"
Ne pas oublier d'inscrire le "" à la fin du chemin où sont tes fichiers
Remplace ceci : '-------------------------------------------- 'Répertoire de départ à définir... Répertoire = "X:PUBLICFABGAMMESBUS" '--------------------------------------------
Par
ChDrive "X" ChDir "X:PUBLICFABGAMMESBUS"
Ne pas oublier d'inscrire le "" à la fin du chemin où sont tes fichiers
modjow
Le mardi 28 Janvier 2014 à 11:58 par Modjow :
Bonjour,
Voici mon problème :
Je dois réaliser une base de données à partir de differents fichier Excel (tous les fichier sont de la même forme).
Tous ces fichiers se trouvent dans des sous repertoires qui se trouvent dans un seul gros repertoire. (Repertoire_principalSous_repertoireFichier.xls)
J'ai donc besoin d'une macro qui va ouvrir le "Repertoire_principa"l , ouvrir chaque "Sous_repertoire" en automatique et ouvrir le "Fichier.xls "se trouvant dans le repertoire, recupèrer certaines données dans le fichier ( j'ai déja une macro qui permet de récupèrer ces données) les stocker dans un fichier Excel "Synthèse" et ainsi de suite..avec tous les fichiers Excel.
Je ne sais pas si j'ai été très clair, alors si vous avez besoin de plus de précisions n'hesitez pas.
Merci d'avance pour l'attention que vous accorderez à mon petit problème!
Merci! sa à l'air de fonctionner, cependant tous mes fichier Excel ont une Macro qui fait que au démarrage j'ai un UserForm qui s'affiche avec un choix a 2 possibilités. Je dois appuyer sur entrée à chaque ouverture d'un nouveau fichier Excel.
Je voulais savoir si il etait possible d'avoir un code qui permet de simulier la touche entrée, ou encore de ne pas affichier le UserForme des fichiers Excel?
Encore merci!
Le mardi 28 Janvier 2014 à 11:58 par Modjow :
Bonjour,
Voici mon problème :
Je dois réaliser une base de données à partir de
differents fichier Excel (tous les fichier sont de la même forme).
Tous ces fichiers se trouvent dans des sous repertoires qui se trouvent dans un
seul gros repertoire. (Repertoire_principalSous_repertoireFichier.xls)
J'ai donc besoin d'une macro qui va ouvrir le "Repertoire_principa"l
, ouvrir chaque "Sous_repertoire" en automatique et ouvrir le
"Fichier.xls "se trouvant dans le repertoire, recupèrer
certaines données dans le fichier ( j'ai déja une macro qui
permet de récupèrer ces données) les stocker dans un
fichier Excel "Synthèse" et ainsi de suite..avec tous les
fichiers Excel.
Je ne sais pas si j'ai été très clair, alors si vous avez
besoin de plus de précisions n'hesitez pas.
Merci d'avance pour l'attention que vous accorderez à mon petit
problème!
Merci! sa à l'air de fonctionner, cependant tous mes fichier Excel ont une Macro qui fait que au démarrage j'ai un UserForm qui s'affiche avec un choix a 2 possibilités.
Je dois appuyer sur entrée à chaque ouverture d'un nouveau fichier Excel.
Je voulais savoir si il etait possible d'avoir un code qui permet de simulier la touche entrée, ou encore de ne pas affichier le UserForme des fichiers Excel?
Je dois réaliser une base de données à partir de differents fichier Excel (tous les fichier sont de la même forme).
Tous ces fichiers se trouvent dans des sous repertoires qui se trouvent dans un seul gros repertoire. (Repertoire_principalSous_repertoireFichier.xls)
J'ai donc besoin d'une macro qui va ouvrir le "Repertoire_principa"l , ouvrir chaque "Sous_repertoire" en automatique et ouvrir le "Fichier.xls "se trouvant dans le repertoire, recupèrer certaines données dans le fichier ( j'ai déja une macro qui permet de récupèrer ces données) les stocker dans un fichier Excel "Synthèse" et ainsi de suite..avec tous les fichiers Excel.
Je ne sais pas si j'ai été très clair, alors si vous avez besoin de plus de précisions n'hesitez pas.
Merci d'avance pour l'attention que vous accorderez à mon petit problème!
Merci! sa à l'air de fonctionner, cependant tous mes fichier Excel ont une Macro qui fait que au démarrage j'ai un UserForm qui s'affiche avec un choix a 2 possibilités. Je dois appuyer sur entrée à chaque ouverture d'un nouveau fichier Excel.
Je voulais savoir si il etait possible d'avoir un code qui permet de simulier la touche entrée, ou encore de ne pas affichier le UserForme des fichiers Excel?
Encore merci!
MichD
'------------------------------- Merci! sa à l'air de fonctionner, cependant tous mes fichiers Excel ont une Macro qui fait qu’au démarrage j'ai un UserForm qui s'affiche avec un choix a 2 possibilités. '-------------------------------
Ta macro contient déjà des 2 lignes de code, dont celle-ci, en début de procédure :
Cette ligne désactive les macros événementielles d'Excel sauf si tu travailles sur une version d'Excel plus ancienne qu'Excel 2003. Par conséquent, les macros du thisworkbook Private Sub Workbook_Activate() ET Private Sub Workbook_Open() ne s'exécutent à l'ouverture des fichiers contenant de telles macros et toutes les autres macros événementielles. Application.EnableEvents = False
Cette ligne de code à la fin du code remet la valeur de la propriété à True. Application.EnableEvents = True
Tu peux toujours essayer ceci. Ajoute cette ligne de code SendKeys "~" devant cette ligne de code : Workbooks.Open (Fichier & "" & MonFichier)
Si cela ne fonctionne pas, donne-moi ta version d'Excel et dis-moi le type de macros qui s'exécutent à l'ouverture des fichiers.
'-------------------------------
Merci! sa à l'air de fonctionner, cependant tous mes fichiers Excel ont une
Macro
qui fait qu’au démarrage j'ai un UserForm qui s'affiche avec un choix a 2
possibilités.
'-------------------------------
Ta macro contient déjà des 2 lignes de code, dont celle-ci, en début de
procédure :
Cette ligne désactive les macros événementielles d'Excel sauf si tu
travailles sur
une version d'Excel plus ancienne qu'Excel 2003. Par conséquent, les macros
du thisworkbook
Private Sub Workbook_Activate() ET Private Sub Workbook_Open() ne
s'exécutent à
l'ouverture des fichiers contenant de telles macros et toutes les autres
macros événementielles.
Application.EnableEvents = False
Cette ligne de code à la fin du code remet la valeur de la propriété à True.
Application.EnableEvents = True
Tu peux toujours essayer ceci. Ajoute cette ligne de code SendKeys "~"
devant cette
ligne de code : Workbooks.Open (Fichier & "" & MonFichier)
'------------------------------- Merci! sa à l'air de fonctionner, cependant tous mes fichiers Excel ont une Macro qui fait qu’au démarrage j'ai un UserForm qui s'affiche avec un choix a 2 possibilités. '-------------------------------
Ta macro contient déjà des 2 lignes de code, dont celle-ci, en début de procédure :
Cette ligne désactive les macros événementielles d'Excel sauf si tu travailles sur une version d'Excel plus ancienne qu'Excel 2003. Par conséquent, les macros du thisworkbook Private Sub Workbook_Activate() ET Private Sub Workbook_Open() ne s'exécutent à l'ouverture des fichiers contenant de telles macros et toutes les autres macros événementielles. Application.EnableEvents = False
Cette ligne de code à la fin du code remet la valeur de la propriété à True. Application.EnableEvents = True
Tu peux toujours essayer ceci. Ajoute cette ligne de code SendKeys "~" devant cette ligne de code : Workbooks.Open (Fichier & "" & MonFichier)
Si cela ne fonctionne pas, donne-moi ta version d'Excel et dis-moi le type de macros qui s'exécutent à l'ouverture des fichiers.
modjow
Le mardi 28 Janvier 2014 à 11:58 par Modjow :
Bonjour,
Voici mon problème :
Je dois réaliser une base de données à partir de differents fichier Excel (tous les fichier sont de la même forme).
Tous ces fichiers se trouvent dans des sous repertoires qui se trouvent dans un seul gros repertoire. (Repertoire_principalSous_repertoireFichier.xls)
J'ai donc besoin d'une macro qui va ouvrir le "Repertoire_principa"l , ouvrir chaque "Sous_repertoire" en automatique et ouvrir le "Fichier.xls "se trouvant dans le repertoire, recupèrer certaines données dans le fichier ( j'ai déja une macro qui permet de récupèrer ces données) les stocker dans un fichier Excel "Synthèse" et ainsi de suite..avec tous les fichiers Excel.
Je ne sais pas si j'ai été très clair, alors si vous avez besoin de plus de précisions n'hesitez pas.
Merci d'avance pour l'attention que vous accorderez à mon petit problème!
C'est bizarre mais j'ai toujours le même problème. Lorsque je lance la macro, rien ne se passe.
Le mardi 28 Janvier 2014 à 11:58 par Modjow :
Bonjour,
Voici mon problème :
Je dois réaliser une base de données à partir de
differents fichier Excel (tous les fichier sont de la même forme).
Tous ces fichiers se trouvent dans des sous repertoires qui se trouvent dans un
seul gros repertoire. (Repertoire_principalSous_repertoireFichier.xls)
J'ai donc besoin d'une macro qui va ouvrir le "Repertoire_principa"l
, ouvrir chaque "Sous_repertoire" en automatique et ouvrir le
"Fichier.xls "se trouvant dans le repertoire, recupèrer
certaines données dans le fichier ( j'ai déja une macro qui
permet de récupèrer ces données) les stocker dans un
fichier Excel "Synthèse" et ainsi de suite..avec tous les
fichiers Excel.
Je ne sais pas si j'ai été très clair, alors si vous avez
besoin de plus de précisions n'hesitez pas.
Merci d'avance pour l'attention que vous accorderez à mon petit
problème!
C'est bizarre mais j'ai toujours le même problème. Lorsque je lance la macro, rien ne se passe.
Je dois réaliser une base de données à partir de differents fichier Excel (tous les fichier sont de la même forme).
Tous ces fichiers se trouvent dans des sous repertoires qui se trouvent dans un seul gros repertoire. (Repertoire_principalSous_repertoireFichier.xls)
J'ai donc besoin d'une macro qui va ouvrir le "Repertoire_principa"l , ouvrir chaque "Sous_repertoire" en automatique et ouvrir le "Fichier.xls "se trouvant dans le repertoire, recupèrer certaines données dans le fichier ( j'ai déja une macro qui permet de récupèrer ces données) les stocker dans un fichier Excel "Synthèse" et ainsi de suite..avec tous les fichiers Excel.
Je ne sais pas si j'ai été très clair, alors si vous avez besoin de plus de précisions n'hesitez pas.
Merci d'avance pour l'attention que vous accorderez à mon petit problème!
C'est bizarre mais j'ai toujours le même problème. Lorsque je lance la macro, rien ne se passe.
MichD
Tu as essayé d'exécuter ta procédure pas à pas en utilisant la touche F8
Tu as essayé d'exécuter ta procédure pas à pas en utilisant la touche F8
Tu as essayé d'exécuter ta procédure pas à pas en utilisant la touche F8
modjow
Le mardi 28 Janvier 2014 à 11:58 par Modjow :
Bonjour,
Voici mon problème :
Je dois réaliser une base de données à partir de differents fichier Excel (tous les fichier sont de la même forme).
Tous ces fichiers se trouvent dans des sous repertoires qui se trouvent dans un seul gros repertoire. (Repertoire_principalSous_repertoireFichier.xls)
J'ai donc besoin d'une macro qui va ouvrir le "Repertoire_principa"l , ouvrir chaque "Sous_repertoire" en automatique et ouvrir le "Fichier.xls "se trouvant dans le repertoire, recupèrer certaines données dans le fichier ( j'ai déja une macro qui permet de récupèrer ces données) les stocker dans un fichier Excel "Synthèse" et ainsi de suite..avec tous les fichiers Excel.
Je ne sais pas si j'ai été très clair, alors si vous avez besoin de plus de précisions n'hesitez pas.
Merci d'avance pour l'attention que vous accorderez à mon petit problème!
Oui j'ai essayé plusieurs fois, il ne se passe rien..
En mode pas à pas je passe de
For Each Fichier In F.SubFolders
directement à
Application.ScreenUpdating = True Application.EnableEvents = True End Sub
En fait il n'ouvre aucune fichier de mon repertoire.
Le mardi 28 Janvier 2014 à 11:58 par Modjow :
Bonjour,
Voici mon problème :
Je dois réaliser une base de données à partir de
differents fichier Excel (tous les fichier sont de la même forme).
Tous ces fichiers se trouvent dans des sous repertoires qui se trouvent dans un
seul gros repertoire. (Repertoire_principalSous_repertoireFichier.xls)
J'ai donc besoin d'une macro qui va ouvrir le "Repertoire_principa"l
, ouvrir chaque "Sous_repertoire" en automatique et ouvrir le
"Fichier.xls "se trouvant dans le repertoire, recupèrer
certaines données dans le fichier ( j'ai déja une macro qui
permet de récupèrer ces données) les stocker dans un
fichier Excel "Synthèse" et ainsi de suite..avec tous les
fichiers Excel.
Je ne sais pas si j'ai été très clair, alors si vous avez
besoin de plus de précisions n'hesitez pas.
Merci d'avance pour l'attention que vous accorderez à mon petit
problème!
Oui j'ai essayé plusieurs fois, il ne se passe rien..
En mode pas à pas je passe de
For Each Fichier In F.SubFolders
directement à
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
En fait il n'ouvre aucune fichier de mon repertoire.
Je dois réaliser une base de données à partir de differents fichier Excel (tous les fichier sont de la même forme).
Tous ces fichiers se trouvent dans des sous repertoires qui se trouvent dans un seul gros repertoire. (Repertoire_principalSous_repertoireFichier.xls)
J'ai donc besoin d'une macro qui va ouvrir le "Repertoire_principa"l , ouvrir chaque "Sous_repertoire" en automatique et ouvrir le "Fichier.xls "se trouvant dans le repertoire, recupèrer certaines données dans le fichier ( j'ai déja une macro qui permet de récupèrer ces données) les stocker dans un fichier Excel "Synthèse" et ainsi de suite..avec tous les fichiers Excel.
Je ne sais pas si j'ai été très clair, alors si vous avez besoin de plus de précisions n'hesitez pas.
Merci d'avance pour l'attention que vous accorderez à mon petit problème!
Oui j'ai essayé plusieurs fois, il ne se passe rien..
En mode pas à pas je passe de
For Each Fichier In F.SubFolders
directement à
Application.ScreenUpdating = True Application.EnableEvents = True End Sub
En fait il n'ouvre aucune fichier de mon repertoire.
MichD
Essaie comme ceci :
Toutes les corrections sont incluses dans cette procédure.
'----------------------------------------------------- Sub test() Dim Fs As Scripting.FileSystemObject, F As Folder, Sf As Object Dim Fichier As Object, MonFichier As String, Répertoire As String Dim Wk As Workbook, Dest As Workbook, Compteur As Long Dim DerLig As Long, DerCol As Long, LastRow As Long, Z As String
'Répertoire de départ à définir... Répertoire = "X:PUBLICFABGAMMESBUS"
ChDrive Left(Répertoire, 1) ChDir Répertoire
Set Dest = ThisWorkbook
Set Fs = CreateObject("Scripting.FileSystemObject") Set F = Fs.GetFolder(Répertoire)
For Each Sf In F.SubFolders For Each Fichier In Sf.Files Z = Left(Fichier, InStrRev(Fichier, "") - 1) MonFichier = Dir(Z & "" & "*.XL*") If Err = 0 Then Do While MonFichier <> "" With Dest With .Worksheets("Liste FT") If Not IsEmpty(.UsedRange) Then LastRow = .Cells.Find("*", LookIn:=xlValues, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row + 1 Else LastRow = 1 End If End With Workbooks.Open Fichier Set Wk = ActiveWorkbook If Not IsEmpty(Wk.Worksheets("Temps").UsedRange) Then With Wk 'détermine la ligne où l'info du fichier à 'ouvrir sera copiée dans 'le fichier de compilation With .Worksheets("Temps") If Not IsEmpty(.UsedRange) Then DerLig = .Cells.Find("*", LookIn:=xlValues, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row DerCol = .Cells.Find("*", LookIn:=xlValues, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious).Column Else DerLig = 1: DerCol = 1 End If
'La copie se fait ici Compteur = Compteur + 1 If Compteur = 1 Then .Range("A1", .Cells(DerLig, DerCol)).Copy _ Dest.Worksheets("Liste FT").Range("A" & LastRow) Else .Range("A2", .Cells(DerLig, DerCol)).Copy _ Dest.Worksheets("Liste FT").Range("A" & LastRow) End If End With End With End If Wk.Close False MonFichier = Dir() End With Loop Else Err.Clear End If Next Next Application.ScreenUpdating = True Application.EnableEvents = True End Sub '---------------------------------------------------------------------
Essaie comme ceci :
Toutes les corrections sont incluses dans cette procédure.
'-----------------------------------------------------
Sub test()
Dim Fs As Scripting.FileSystemObject, F As Folder, Sf As Object
Dim Fichier As Object, MonFichier As String, Répertoire As String
Dim Wk As Workbook, Dest As Workbook, Compteur As Long
Dim DerLig As Long, DerCol As Long, LastRow As Long, Z As String
'Répertoire de départ à définir...
Répertoire = "X:PUBLICFABGAMMESBUS"
ChDrive Left(Répertoire, 1)
ChDir Répertoire
Set Dest = ThisWorkbook
Set Fs = CreateObject("Scripting.FileSystemObject")
Set F = Fs.GetFolder(Répertoire)
For Each Sf In F.SubFolders
For Each Fichier In Sf.Files
Z = Left(Fichier, InStrRev(Fichier, "") - 1)
MonFichier = Dir(Z & "" & "*.XL*")
If Err = 0 Then
Do While MonFichier <> ""
With Dest
With .Worksheets("Liste FT")
If Not IsEmpty(.UsedRange) Then
LastRow = .Cells.Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row + 1
Else
LastRow = 1
End If
End With
Workbooks.Open Fichier
Set Wk = ActiveWorkbook
If Not IsEmpty(Wk.Worksheets("Temps").UsedRange) Then
With Wk
'détermine la ligne où l'info du fichier à
'ouvrir sera copiée dans
'le fichier de compilation
With .Worksheets("Temps")
If Not IsEmpty(.UsedRange) Then
DerLig = .Cells.Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
DerCol = .Cells.Find("*", LookIn:=xlValues, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
Else
DerLig = 1: DerCol = 1
End If
'La copie se fait ici
Compteur = Compteur + 1
If Compteur = 1 Then
.Range("A1", .Cells(DerLig, DerCol)).Copy _
Dest.Worksheets("Liste FT").Range("A" &
LastRow)
Else
.Range("A2", .Cells(DerLig, DerCol)).Copy _
Dest.Worksheets("Liste FT").Range("A" &
LastRow)
End If
End With
End With
End If
Wk.Close False
MonFichier = Dir()
End With
Loop
Else
Err.Clear
End If
Next
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
'---------------------------------------------------------------------
Toutes les corrections sont incluses dans cette procédure.
'----------------------------------------------------- Sub test() Dim Fs As Scripting.FileSystemObject, F As Folder, Sf As Object Dim Fichier As Object, MonFichier As String, Répertoire As String Dim Wk As Workbook, Dest As Workbook, Compteur As Long Dim DerLig As Long, DerCol As Long, LastRow As Long, Z As String
'Répertoire de départ à définir... Répertoire = "X:PUBLICFABGAMMESBUS"
ChDrive Left(Répertoire, 1) ChDir Répertoire
Set Dest = ThisWorkbook
Set Fs = CreateObject("Scripting.FileSystemObject") Set F = Fs.GetFolder(Répertoire)
For Each Sf In F.SubFolders For Each Fichier In Sf.Files Z = Left(Fichier, InStrRev(Fichier, "") - 1) MonFichier = Dir(Z & "" & "*.XL*") If Err = 0 Then Do While MonFichier <> "" With Dest With .Worksheets("Liste FT") If Not IsEmpty(.UsedRange) Then LastRow = .Cells.Find("*", LookIn:=xlValues, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row + 1 Else LastRow = 1 End If End With Workbooks.Open Fichier Set Wk = ActiveWorkbook If Not IsEmpty(Wk.Worksheets("Temps").UsedRange) Then With Wk 'détermine la ligne où l'info du fichier à 'ouvrir sera copiée dans 'le fichier de compilation With .Worksheets("Temps") If Not IsEmpty(.UsedRange) Then DerLig = .Cells.Find("*", LookIn:=xlValues, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row DerCol = .Cells.Find("*", LookIn:=xlValues, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious).Column Else DerLig = 1: DerCol = 1 End If
'La copie se fait ici Compteur = Compteur + 1 If Compteur = 1 Then .Range("A1", .Cells(DerLig, DerCol)).Copy _ Dest.Worksheets("Liste FT").Range("A" & LastRow) Else .Range("A2", .Cells(DerLig, DerCol)).Copy _ Dest.Worksheets("Liste FT").Range("A" & LastRow) End If End With End With End If Wk.Close False MonFichier = Dir() End With Loop Else Err.Clear End If Next Next Application.ScreenUpdating = True Application.EnableEvents = True End Sub '---------------------------------------------------------------------
