Déplacer des fichiers vers un répertoire.

[Moulinois]

Bonjour,

J'ai une macro (A) qui travaille et synthétise tous les classeurs d'un dossier (C1, C2, C3, ...). Je voudrais ensuite qu'elle les déplace dans un sous-répertoire "Archive".

-> Comment obtenir une liste des fichiers du répertoire (sauf la macro 😀) et les envoyer dans "Archive" ?

Merci

@+

 

[GCFRG]

Re : Déplacer des fichiers vers un répertoire.

salut Moulinois
une piste
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim chemin As String, nom As String
Application.DisplayAlerts = False
chemin = "c:\tmp"
nom = ThisWorkbook.Name
ActiveWorkbook.SaveCopyAs chemin & "\" & nom & ".xls"
End Sub

à tester et à adapter à ton cas

@+GC

 

[job75]

Re : Déplacer des fichiers vers un répertoire.

Bonjour Moulinois,

En continuant le travail déjà fait sur l'autre fil, je suggère la création d'une collection c et une boucle For à la fin :

Dim c As New Collection
Chemin = ThisWorkbook.Path & "\"
monfichier = Dir(Chemin & "*.xls")
classeur1 = ActiveWorkbook.Name
Application.DisplayAlerts = False
On Error Resume Next

Do Until monfichier = ""
c.Add monfichier
test = ""
test = Sheets(monfichier).Name
If monfichier <> classeur1 And test = "" And monfichier <> "" Then
'--------------
End If
monfichier = Dir
Loop

For i = 1 To c.Count - 1
If c(i) <> "classeur1"
Workbooks(c(i)).Close 'au cas où le fichier serait ouvert
Workbooks(c(i)).Move Chemin & "Archive"
End If
Next

A+

 

[kiki29]

Re : Déplacer des fichiers vers un répertoire.

salut, Voir dans aide en ligne FileCopy et Kill
sinon via FSO ( Microsoft Scripting Runtime) Move

 

[Moulinois]

Re : Déplacer des fichiers vers un répertoire.

Re,

J'ai cherché de mon côté et j'ai trouvé une solution relativement élégante en continuant avec la même idée que job75 :

    Chemin = ThisWorkbook.Path & "\"
    Monfichier = Dir(Chemin & "*.xls")
    Recap= ActiveWorkbook.Name
    
    Do Until Monfichier = ""
        If Monfichier <> Recap Then
            [B]Name Chemin & Monfichier As Chemin & "Archive\" & Monfichier[/B]
        End If
    Monfichier = Dir
    Loop

Name a l'air bien pratique, non ?

 

[job75]

Re : Déplacer des fichiers vers un répertoire.

Re
J'ai ajouté Workbooks(...) dans mon message précédent, sinon ça ne marchait pas.
A+

Edit : bravo Moulinois pour l'instruction Name. Mais il faut que le fichier soit fermé.

 

[Moulinois]

Re : Déplacer des fichiers vers un répertoire.

Re,

Edit : bravo Moulinois pour l'instruction Name.

Merci.

Mais il faut que le fichier soit fermé.

C'est fait plus haut dans le code mais vous ne pouviez pas le deviner.