Boucler fichiers dans 1 répertoire + copier-coller

FaridP

XLDnaute Occasionnel
Bonjour à tous,

Je souhaite récupérer des informations sur différents fichiers (tous au même format) se trouvant dans un répertoire et les coller à la suite de mon document actif puis refermer le fichier et le déplacer dans un répertoire nommé "Done".

Si l'ouverture des fichiers ne me pose pas de soucis, je n'arrive pas récupérer les données, les coller et déplacer le fichier, pourriez-vous m'aider ?
Voici mon code :
Code:
Sub BoucleFichiers()
    Dim Chemin As String, Fichier As String
    'Répertoire contenant les fichiers
    Chemin = "C:\Exports\"
    'Boucle sur tous les fichiers xls du répertoire.
    Fichier = Dir(Chemin & "*.xls")
   
    Do While Len(Fichier) > 0

'Si "A2" du fichier ouvert est vide alors on le referme pour passer au fichier suivant
'Si "A2" <> copier toutes les lignes à partir de "A2" pour les coller sur la feuille active du document contenant
'la macro (après la dernière ligne non vide) + déplacer le fichier dans un répertoire "Done" et passer au fichier suivant

        Fichier = Dir()
    Loop
End Sub

Merci ne serait-ce que pour avoir pris le temps de me lire :)

Farid
 

Roland_M

XLDnaute Barbatruc
bonjour,

salut Farid !
j'ai fais ceci vite fais, il faudrait que tu crées des dossiers temporaires avec qq fichiers pour faire des essais !?
je vais essayer de mon côté pendant ce temps car je n'ai rien vérifié pour l'instant

EDIT: code supprimé voir la suite . . .
 
Dernière édition:

FaridP

XLDnaute Occasionnel
J'ai un message d'erreur, je te joins la capture d'écran.

Et le code adapté :
Code:
Const CheminSource$ = "C:\Users\Farid\Documents\Documents\PJ_CONSO_PLUS\Exports\" '< VOIR SI CECI EST OK !?
Const CheminDestin$ = "C:\Users\Farid\Documents\Documents\PJ_CONSO_PLUS\Exports\Done\"    '< ::::
Dim Fichier$
Sub BoucleFichiers()
'Si "A2" du fichier ouvert est vide alors on le referme pour passer au fichier suivant
'Si "A2" <> copier toutes les lignes à partir de "A2" pour les coller sur la feuille active du document contenant
'la macro (après la dernière ligne non vide) + déplacer le fichier dans un répertoire "Done" et passer au fichier suivant

Dim NoLigEncours&, NoDernLigEnCours&, DernLig&

Sheets(1).Activate 'active la 1'feuille du classeur qui recevra les données
Fichier = Dir(CheminSource & "*.xls")
While Len(Fichier) > 0
    NoDernLigEnCours = Range("A" & Rows.Count).End(xlUp).Row 'dern lig de thisworkbook
    If Cells(NoDernLigEnCours, "A") > "" Then NoDernLigEnCours = NoDernLigEnCours + 1
       Workbooks(Fichier).Open 'il devient actif 'il devient actif
    If Sheets(1).Range("A2") > "" Then 'test la cell.A2 de la première feuille !?
       Sheets(1).Activate 'active la feuille(1)
       DernLig = Range("A" & Rows.Count).End(xlUp).Row
       Range("A2:A" & DernLig).Copy Destination:=ThisWorkbook.Sheets(1).Cells(NoDernLigEnCours, "A")
       Workbooks(Fichier).Close False 'referme
       Name CheminSource & Fichier As CheminDestin & Fichier 'déplace
    Else
       Workbooks(Fichier).Close False
    End If
    Fichier = Dir()
Wend
End Sub
 

Pièces jointes

  • Capture.PNG
    Capture.PNG
    5.5 KB · Affichages: 47

FaridP

XLDnaute Occasionnel
Roland,

Je suis à la fois content mais très gêné. Je ne veux pas que tu bosses à ma place non plus et encore moins que tu perdes ton temps.

Je te remercie très sincèrement et je t'assure que je passerai le temps nécessaire à comprendre l'intégralité du code. C'est le minimum vu ton investissement.

Encore merci ! Même si ce ne sont que des mots, c'est sincère ! ;):)
 

Roland_M

XLDnaute Barbatruc
re

voilà mon ami, pour moi ça fonctionne faire essai comme je t'ai dis avec des dossiers et fichiers temporaires !?

Code:
'Je souhaite récupérer des informations sur différents fichiers (tous au même format)
'se trouvant dans un répertoire et les coller à la suite de mon document actif
'puis refermer le fichier et le déplacer dans un répertoire nommé "Done".

'Const CheminSource$ = "E:\Zessai\"  ' < ceci c'est juste pour mes essais !
'Const CheminDestin$ = "E:\Zdone\"

Const CheminSource$ = "C:\Users\Farid\Documents\Documents\PJ_CONSO_PLUS\Exports\" '< VOIR SI CECI EST OK !?
Const CheminDestin$ = "C:\Users\Farid\Documents\Documents\PJ_CONSO_PLUS\Exports\Done\"    '< ::::
Dim Fichier$

'Si "A2" du fichier ouvert est vide alors on le referme pour passer au fichier suivant
'Si "A2" <> copier toutes les lignes à partir de "A2" pour les coller sur la feuille active du document contenant
'la macro (après la dernière ligne non vide) + déplacer le fichier dans un répertoire "Done" et passer au fichier suivant
Sub BoucleFichiers()
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual: Application.EnableEvents = False
Dim NoLigEncours&, NoDernLigEnCours&, DernLig&

Sheets(1).Activate 'active la 1'feuille de ce classeur qui recevra les données
Fichier = Dir(CheminSource & "*.xls") 'lecture des fichiers.xls
While Len(Fichier) > 0
 If Fichier <> ThisWorkbook.Name Then 'test si ce n'est pas celui-ci !?
    NoDernLigEnCours = Range("A" & Rows.Count).End(xlUp).Row 'dern lig de thisworkbook
    If Cells(NoDernLigEnCours, "A") > "" Then NoDernLigEnCours = NoDernLigEnCours + 1
       Workbooks.Open Filename:=CheminSource & Fichier 'il devient actif 'il devient actif
    If Sheets(1).Range("A2") > "" Then 'test la cell.A2 de la première feuille !?
       Sheets(1).Activate 'active la feuille(1)
       DernLig = Range("A" & Rows.Count).End(xlUp).Row
       Range("A2:A" & DernLig).Copy Destination:=ThisWorkbook.Sheets(1).Cells(NoDernLigEnCours, "A")
       Workbooks(Fichier).Close False 'referme
       Name CheminSource & Fichier As CheminDestin & Fichier 'déplace
    Else
       Workbooks(Fichier).Close False
    End If
 End If
 Fichier = Dir()
Wend
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic: Application.EnableEvents = True
End Sub
 
Dernière édition:

FaridP

XLDnaute Occasionnel
Merci Roland

Par contre, ça doit merder chez moi car les lignes copiées sont celles du classeur contenant la macro et non celles des fichiers Excel contenu dans le dossier et qui sont pourtant bien déplacés.

Pourtant j'ai fait un copier-coller du code bête et méchant sans rien changer :(
 

Roland_M

XLDnaute Barbatruc
re

reprends ceci:
Code:
'Je souhaite récupérer des informations sur différents fichiers (tous au même format)
'se trouvant dans un répertoire et les coller à la suite de mon document actif
'puis refermer le fichier et le déplacer dans un répertoire nommé "Done".

'Const CheminSource$ = "E:\Zessai\"  ' < ceci c'est juste pour mes essais !
'Const CheminDestin$ = "E:\Zdone\"

Const CheminSource$ = "C:\Users\Farid\Documents\Documents\PJ_CONSO_PLUS\Exports\"
Const CheminDestin$ = "C:\Users\Farid\Documents\Documents\PJ_CONSO_PLUS\Exports\Done\"
Dim Fichier$

'Si "A2" du fichier ouvert est vide alors on le referme pour passer au fichier suivant
'Si "A2" <> copier toutes les lignes à partir de "A2" pour les coller sur la feuille active du document contenant
'la macro (après la dernière ligne non vide) + déplacer le fichier dans un répertoire "Done" et passer au fichier suivant
Sub BoucleFichiers()
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual: Application.EnableEvents = False
Dim NoLigEncours&, NoDernLigEnCours&, DernLig&

Sheets(1).Activate 'active la 1'feuille de ce classeur qui recevra les données
Fichier = Dir(CheminSource & "*.xls") 'lecture des fichiers.xls
While Len(Fichier) > 0
If Fichier <> ThisWorkbook.Name Then 'test si ce n'est pas celui-ci !?
    ThisWorkbook.Activate: Sheets(1).Activate
    NoDernLigEnCours = Range("A" & Rows.Count).End(xlUp).Row 'dern lig de thisworkbook
    If Cells(NoDernLigEnCours, "A") > "" Then NoDernLigEnCours = NoDernLigEnCours + 1
       Workbooks.Open Filename:=CheminSource & Fichier
       Workbooks(Fichier).Activate
    If Sheets(1).Range("A2") > "" Then 'test la cell.A2 de la première feuille !?
       Sheets(1).Activate 'active la feuille(1)
       DernLig = Range("A" & Rows.Count).End(xlUp).Row
       Workbooks(Fichier).Sheets(1).Range("A2:A" & DernLig).Copy Destination:=ThisWorkbook.Sheets(1).Cells(NoDernLigEnCours, "A")
       Workbooks(Fichier).Close False 'referme
       Name CheminSource & Fichier As CheminDestin & Fichier 'déplace
    Else
       Workbooks(Fichier).Close False
    End If
End If
Fichier = Dir()
Wend
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic: Application.EnableEvents = True
End Sub
 

FaridP

XLDnaute Occasionnel
Ecoute ! Ca fonctionne à merveille !

Ca ne me copie que le contenu de la colonne A alors que je veux récupérer la ligne entière mais je ne t'embête pas plus longtemps et je vais tenter de modifier cette partie.

Vraiment Roland, je ne sais comment te remercier pour ce boulot, c'est énorme !
 

FaridP

XLDnaute Occasionnel
C'est de ma faute, je n'ai pas été très clair non plus.

En fait si A2 n'est pas vide, je souhaite récupérer toutes les lignes (la ligne 2 et celles du dessous).

Ton code fonctionne déjà très bien, il faut juste que j'arrive à récupérer la ligne entière sans limiter à la colonne A
 

Discussions similaires

Réponses
19
Affichages
2 K
Réponses
15
Affichages
782

Statistiques des forums

Discussions
311 733
Messages
2 082 015
Membres
101 868
dernier inscrit
pierreselo33