Déplacement de classeur d'un dossier en fonction de sont nom

bonsoir

je souhaiterais savoir s'il était possible avec une macro de déplacer des classeur dans un dossier spécifique

ces classeur n'on pas la nomenclature identique bien entendu

merci pour vos réponse et bonne fête

Bonjour,

Je pense que c'est possible mais j'ai l'impression qu'il serait plus simple et moins couteux de le faire à la main.

A la rigueur, il faudrait que chaque fichier commence vraiment par le nom du dossier auquel il est destiné...

Cdlt,

mon souci est que je suis en phase de test sur un nombre faible le nombre de classeur peux montée jusqu'à 250

je suis en train de travailler sur ce code trouve sur internet pour mettre à la pla place contient , mes je n'arrive a rien pour le moment

Déplacement de fichiers d'un répertoire dans un autre avec Name

On déplace dans un autre répertoire tous les fichiers dont le nom ne contiennent pas ABC.

ub essai2()
repertoire1 = "c:\toto\"
repertoire2 = "c:\totobis\"
nf = Dir(repertoire1 & "*.*")
Do While nf <> ""
If Not nf Like "*ABC*" Then
Name repertoire1 & nf As repertoire2 & nf
End If
nf = Dir
Loop
End Sub

Voici un code à essayer en modifiant le chemin du dossier contenant les fichiers et les sous-dossiers de destination :

Sub DeplacerFichiers()

Dim dossiers()

repparent = "C:\...\dossierparent\" '<<<< ADAPTER

dossier = Dir(repparent, vbDirectory) '1ere entrée du dossier parent
While dossier <> "" 'tant qu'il reste des éléments à parcourir
    If Not dossier Like "*.*" Then 'si dossier est bien un sous-dossier (pas un fichier "*.*" ni dossier courant "." ni dossier parent "..")
        ReDim Preserve dossiers(n) 'redimension du tableau listant les dossiers
        dossiers(n) = dossier 'item n vaut nom sous-dossier en cours
        n = n + 1 'incrementation n
    End If
    dossier = Dir 'suivant
Wend

fichier = Dir(repparent & "*.*") '1er fichier du dossier parent (<<< SI BESOIN : "*.xls*")
While fichier <> "" 'tant qu'il existe des fichiers
    For i = LBound(dossiers) To UBound(dossiers) 'pour chaque sous-dossier du dossier parent
        if fichier like dossiers(i) & "*" then 'si nom fichier commence par nom dossier en cours
            expath = repparent & fichier 'chemin origine complet
            nvpath = repparent & dossiers(i) & "\" & fichier 'chemin destination
            name expath as nvpath 'deplacement (et le cas échéant remplace le fichier dans destination?)
            exit for
        end if
    next i
    fichier = Dir 'fichier suivant
Wend

End Sub

Je n'ai pas testé donc il est possible qu'il faille apporter des modifications.

CODE EDITE !

Cdlt,

Merci pour ton retour et bonne année 2021

la macro est parfaite

Merci, très bonne année à toi également !