Transfert de fichier d'un dossier à l'autre
Bonjour à tous
Dans l'excel en PJ, j'ai une macro qui me renomme automatiquement tous les fichiers situés dans un dossier "Origine", qui me renomme les fichiers selon les cellules qu'ils contiennent, et qui me les enregistre dans un autre dossier "destination". Cependant j'ai un souci : les fichiers se transfèrent bien dans le dossier "destination", mais se ne suppriment pas dans le dossier "Origine" (en gros ça fait une copie du fichier), est ce que quelqu'un aurait une solution?
Voici la macro que j'utilise :
Option Explicit
Sub renommer()
Dim origine As String, dest As String
Dim part(1 To 3) As String
Dim Fichier As String
origine = [B1].Value
dest = [B2].Value
Fichier = Dir(origine & "*.xl*") ' 1er fichier
Do While (Len(Fichier) > 0)
Workbooks.Open origine & Fichier
' traitement
part(1) = [E3].Value
part(2) = Mid([F5].Value, 5, 2)
part(3) = Mid([F5].Value, 1, 4)
ActiveWorkbook.Close
FileCopy origine & Fichier, dest & "Fdt_" & part(1) & "_W" & part(2) & "_" & part(3) & Mid(Fichier, InStrRev(Fichier, "."))
Fichier = Dir() ' fichier suivant
Loop
End Sub
Edit modo : code mis entre balises
Bonjour Gueuss et
Une petite présentation ICI serait la bienvenue
Si vous ne l'avez pas encore fait, je vous invite à lire la charte du forum [A LIRE AVANT DE POSTER]
qui vous aidera dans vos demandes et réponses sur ce forum et notamment la mise du code entre balises
Ainsi que sur les fonctionnalités du nouveau forum
Merci de votre participation
Cordialement
C'est bon, au final j'ai trouvé ma solution : il suffit de sauvegarder le chemin d'acces du fichier d'origine au début de la boucle, et de faire un kill du fichier d'origine à la fin de la boucle :
Sub renommer()
Dim origine As String, dest As String
Dim part(1 To 3) As String
Dim Fichier As String
origine = [B1].Value
dest = [B2].Value
Fichier = Dir(origine & "*.xl*") ' 1er fichier
Do While (Len(Fichier) > 0)
Workbooks.Open origine & Fichier
' traitement
Dim fichierdebase As String
fichierdebase = origine & Fichier 'mise en mémoire du chemin d'acces d'origine
part(1) = [E3].Value
part(2) = Mid([F5].Value, 5, 2)
part(3) = Mid([F5].Value, 1, 4)
ActiveWorkbook.Close
FileCopy origine & Fichier, dest & "Fdt_" & part(1) & "_W" & part(2) & "_" & part(3) & Mid(Fichier, InStrRev(Fichier, "."))
Kill fichierdebase 'suppression du fichier d'origine
Fichier = Dir() ' fichier suivant
Loop
End Sub