Copier fichiers de plusieurs sous repertoires dans un seul repertoire

Bonjour les amis,

je m'interesse beaucoup a VBA macro. je veux copier tous les fichiers dans plusieurs sous repertoire dans un seul repertoire.

pourriez vous m'aider a ecrire le code VBA.

merci d'avance.

Bonjour,

Voici une proposition pour copier tous les fichiers contenus par un dossier et ses sous-dossiers :

sub Lancer()
srepsrc$ = "C:\...\" 'dossier parent contenant les sous-dossiers
srepdest$ = "C:\....\" 'dossier destination accueillant les copies
Copier srepsrc, srepdest
end sub

Sub Copier(srepsrc$, srepdest$)
set fso = createobject("Scripting.filesystemobject")
set fd = fso.getfolder(srepsrc)
for each fil in fd.files
    fso.copyfile fil.path, srepdest & fil.name
next fil
for each sfd in fd.subfolders
    Copier sfd.path, srepdest
next sfd
end sub

Il faut adapter les chemins...

Cdlt,

BOnjour,

je vais essayer et reviens vers toi

merci

BOnjour 3GB

une question rapide, ou (dans quel repertoire) est ce qu'on met le fichier Excel contenant le macro.

merci

Bonjour Fidele,

Peux-tu nous donner un peu plus d'informations sur ce que tu veux faire ?

Que veux tu copier ? Et quel serait l'utilité du fichier une fois dans le sous répertoire ?

À te lire,

Bonjour à tous,

Le fichier exécutant peut être placé n'importe où, tant qu'il ne se trouve pas dans l'arborescence du répertoire source.

Il faut mettre les répertoires d'origine et de destination en dur dans le code ou éventuellement obtenir le répertoire source à l'aide d'une boite de dialogue de sélection de dossiers.

Le répertoire de destination est supposé exister au lancement de la macro.

Donc par exemple :

Le fichier exécutant est dans C:\Documents\

Le répertoire source est C:\Desktop\blo\ (>>> il contient des sous-dossiers ...)

Le répertoire de destination est C:\Desktop\bli\

Cdlt,

Bonjour 3GB,

ci dessous le macro dans le fichier Excel que j'ai mis dans Desktop. mais cela ne marche pas. qu'en penses tu?? a quel niveau la faille???

merci beaucoup

Sub Lancer()
srepsrc$ = "C:\Users\aravalitera\Documents\ANNEE 2021\en attente" 'dossier parent contenant les sous-dossiers
srepdest$ = "C:\Users\aravalitera\Documents\ANNEE 2021\Destination" 'dossier destination accueillant les copies
Copier srepsrc, srepdest
End Sub

Sub Copier(srepsrc$, srepdest$)
Set fso = CreateObject("Scripting.filesystemobject")
Set fd = fso.getfolder(srepsrc)
For Each fil In fd.Files
fso.copyfile fil.Path, srepdest & fil.Name
Next fil
For Each sfd In fd.subfolders
Copier sfd.Path, srepdest
Next sfd
End Sub

Bonjour Zalee,

en fait , j'ai besoin de mettre 114 fichiers dans un seul dossier. ces 114 fichiers sont repartis initialement dans 22 sous repertoires.

cordialement

Merci pour ton appui.

Fidele17

Bonjour Fidele,

Essaies avec les slaches.

srepsrc$ = "C:\Users\aravalitera\Documents\ANNEE 2021\en attente\" 'dossier parent contenant les sous-dossiers
srepdest$ = "C:\Users\aravalitera\Documents\ANNEE 2021\Destination\" 'dossier destination accueillant les copies

Et quand tu dis ça ne marche pas, c'est quoi l'erreur affichée ?

Autre solution qui vient de fonctionner chez moi

Sub Test()

Dim FSO As Object
Dim SubFolder As Object
Dim CS As String, CD As String

DS = "Dossier Source"
DD = "Dossier Destination"

Set FSO = CreateObject("Scripting.Filesystemobject")

For Each SubFolder In FSO.getfolder(DS).subfolders
    Fichier = Dir(SubFolder.Path & "\", vbNormal)
Do While Len(Fichier) > 0

FileCopy SubFolder.Path & "\" & Fichier, DD & Fichier

    Fichier = Dir()
    Loop
Next SubFolder

End Sub

Bonjour à tous,

Effectivement, il faut mettre les antislash en fin de chemin, comme l'a suggéré Zalee. Le fichier exécutant (pour répondre à la question précédente maintenant que j'ai vu les répertoires) peut être placé dans le dossier ANNEE 2021 par exemple mais pas dans en attente (sinon il faudrait rajouter une condition).

Pour tester du code, tu peux utiliser le bouton </> sur le ruban d'icones.

@Zalee : En fait, je pense que Fidele17 a besoin de parcourir tous les dossiers contenus dans le dossier en attente. C'est pour ça que j'utilise le fso qui permet d'agir de façon récursive : la fonction Copier s'appelle elle-même.

Cdlt,

Chers 3GB et Zalee,

avec l'antislach , cela a marche parfaitement.

merci pour vos appuis. j'apprecie beaucoup

je vais essayer l'autre solution et reviendrai vers vous.

cordialement

Fidele17

CHers 3GB et Zalee,

l'autre option proposee par Zalee marche tres bien egalement.

encore merci a vous deux

A+

Fidele