Déplacer des fichiers vers un répertoire.

Moulinois

XLDnaute Occasionnel
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 :D) et les envoyer dans "Archive" ?

Merci

@+
 

GCFRG

XLDnaute Occasionnel
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

XLDnaute Barbatruc
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+
 
Dernière édition:

Moulinois

XLDnaute Occasionnel
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 :
Code:
    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

XLDnaute Barbatruc
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é.
 
Dernière édition:

Discussions similaires