Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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
 
Trier par date Trier par votes

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:
Vote positif 0 Vote négatif

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
    5.5 KB · Affichages: 48
Vote positif 0 Vote négatif

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 !
 
Vote positif 0 Vote négatif

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:
Vote positif 0 Vote négatif

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
 
Vote positif 0 Vote négatif

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
 
Vote positif 0 Vote négatif

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 !
 
Vote positif 0 Vote négatif

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
 
Vote positif 0 Vote négatif

Roland_M

XLDnaute Barbatruc
re

je vais y regardé !
mais j'ai besoin de savoir si des données sont collées dans toutes les cellules
ou si tu sais combien de colonnes il peut y avoir au maxi ce qui serait plus simple !
 
Dernière édition:
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

R
  • Question
Microsoft 365 Liste des fichiers dans le répertoire
2 3
Réponses
31
Affichages
985
patricktoulon
J
  • Question
Microsoft 365 macro qui ouvre des fichiers excel de type "analyze in excel" généré par power bi et met à jour un filtre "mois" sur plusieurs tcd
Réponses
0
Affichages
62
JJ69
J
J
  • Question
Microsoft 365 Code VBA
Réponses
10
Affichages
748
jebibo
J
  • Question
XL 2021 Liste des propriétés de fichiers.
3 4 5
Réponses
73
Affichages
3 K
jeff1494
E
  • Question
Microsoft 365 Couleurs de fichiers qui changent
Réponses
1
Affichages
272
mapomme
  • Question
Microsoft 365 Conserver la valeur de ma variable pour l'utiliser dans un autre code
Réponses
3
Affichages
322
mapomme
I
  • Question
Microsoft 365 Renommer des fichiers avec des caractères non reconnus
Réponses
10
Affichages
801
ivan27
I
D
  • Question
Microsoft 365 Couper Coller Fichiers en VBA
Réponses
3
Affichages
727
patricktoulon
  • Résolu(e)
XL 2019 Aide pour un module d'archivage de feuille en pdf dans répertoire
Réponses
5
Affichages
536
Nico2978
K
  • Question
XL 2010 copier des dossiers ou fichiers pour les coller dans un disque dur externe
Réponses
2
Affichages
422
kiki29
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…