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

image

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
Rechercher des sujets similaires à "transfert fichier dossier"