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" ?
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
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
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