Ranger fichiers dans répertoires spécifiques

Bonjour,

Toujours aussi débutant sur excel, j'ai cherché un peu avant de poser ma question et je n'ai trouvé que des macros pour répertorier.

Mon problème est le suivant:

J'ai un certain nombres de fichiers à ranger dans des dossiers spécifiques (environ 200) chaque mois. La particularité c'est que ces fichiers ont le même nom à chaque fois.

Du coup je voudrais avec une macro pouvoir ranger les fichiers dans le bon dossier (par exemple le fichier A.xls va toujours dans même dossier "suivi"). Du coup en mettant dans un même dossier tous les fichiers que je veux ranger, dans une feuille excel les noms des fichiers et en face le dossier où ils doivent être rangé, est ce possible de les ranger?

Pour la macro, si c'est possible, j'avoue que j'ai un peu de mal à la construire, un coup de main serait le bienvenu, svp.

Merci!

Je mets en lien un fichier excel synthétisant ma demande.

Bonjour

Supposant que les fichiers se trouvent dans le même dossier que le fichier qui doit contenir cette macro :

voici un essai

Sub rangement()
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
'parcourir tout le tableau
For i = 2 To [A65536].End(xlUp).Row
    oFSO.MoveFile ThisWorkbook.Path & "\" & Cells(i, "A"), Cells(i, "B") & "\" & Cells(i, "A")
Next i
End Sub

Attention toujours faire un essai avec une sauvegarde des fichiers ne jamais travailler sur les fichiers originaux en cours de développement...

je ne fais pas de test pour vérifier que le dossier de destination existe, ni de test que le fichier a déplacer existe.... attention donc

fred

Re aller je viens de completer le code pour qu'il test au préalable des le fichier source existe et que le dossier de destination existe aussi...

et en plus je test pour savoir si un fichier portant déjà le même nom existe dans le dossier de destination si c'est le cas, il n'y a pas de déplacement

fred

Sub rangement()
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
'parcourir tout le tableau
For i = 2 To [A65536].End(xlUp).Row
    'vérification de l'exitence du fichier a deplacer et que le dossier de destination existe aussi
    If Dir(ThisWorkbook.Path & "\" & Cells(i, "A")) <> "" And oFSO.FolderExists(Cells(i, "B") & "\") Then
    'les deux existes, vérification qu'un fichier portant le nom existe déjà dans le dossier de destination :
        If Dir(Cells(i, "B") & "\" & Cells(i, "A")) = "" Then oFSO.MoveFile ThisWorkbook.Path & "\" & Cells(i, "A"), Cells(i, "B") & "\" & Cells(i, "A")
    End If
Next i
End Sub

Bonjour,

Merci pour ce retour! Ca marche super bien!!!

Petite question, j'ai quelques 200 fichiers, et des fois l'extension change sensiblement (par exemple xls ou xlsm), y a t il un moyen d'enlever l'extension ou il faut absolument avoir l'extension dans le fichier excel?

J'ai enlevé l'extension dans mon fichier pour tester et juste avec le nom il ne déplace pas. Mais en rajoutant l'extension, il déplace comme il faut.

2ème question: si un fichier du même nom existe dans la destination, est ce que ça l'écrase? Si non, j'aimerais bien l'écraser, si jamais j'ai un autre fichier mis à jour par exemple.

Un grand merci à toi!!!!

re

la question est différente, est-il possible que dans tes fichiers à déplacer, deux fichiers peuvent-ils avoir le même nom mais avec deux extensions différentes ?? par exemple A.xls et A.pdf

si c'est pas le cas je penses que l'on peut faire quelque chose sans les extensions

a te relire

Fred

Re pour écraser le fichier de destination pas de soucis, mais on met un message d'avertissement demandant à l'utilisateur de confirmer ou on écrase sans rien dire a personne ???

fred

Re,

Il n'y a pas de fichiers avec la même extension.

On écrase sans rien dire

Re

un nouvel essai

Fred

Ca marche parfaitement!! Un grand merci Fred

Au plaisir et un bon weekend!