Sauvegarde Fichier d'un dossier vers un autre

rambof

XLDnaute Nouveau
Bonjour,
Je vous sollicite pour de l'aide sur ma macro que je n'arrive pas a faire fonctionner.

- J'ai une première macro qui prend les fichiers d'un dossier :

Sub DossierSource() 'choisis un dossier source
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Sélectionnez un dossier", &H201&)
If Not objFolder Is Nothing Then
Rep = objFolder.Items.Item.path
If Right(Rep, 1) <> "\" Then Rep = Rep & "\"
End If
FLoadNomDuREP = Rep
Set objShell = Nothing: Set objFolder = Nothing


Sheets("Sheet1").Cells(17, 6).Value = Rep 'adresse du dossier source ex : "C:\Desktop\"

End Sub

- Une seconde qui est un dossier de réception :

Sub DossierDest() 'choisis un dossier de réception
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Sélectionnez un dossier", &H201&)
If Not objFolder Is Nothing Then
Rep = objFolder.Items.Item.path
If Right(Rep, 1) <> "\" Then Rep = Rep & "\"
End If
FLoadNomDuREP = Rep
Set objShell = Nothing: Set objFolder = Nothing


Sheets("Sheet1").Cells(21, 6).Value = Rep 'adresse du dossier de réception ex : "C:\Desktop\trier\"


End Sub

- Une troisième qui est une boucle de traitement :

Sub BoucleDeTraitement() ' la boucle de traitement des fichiers
Application.ScreenUpdating = False
ChDir Range("F17").Value 'choisis un fichier parmi le dossier source
Fich = Dir(Chemin & "*.xls")
Do While Fich <> ""
Workbooks.Open Chemin & Fich
Call Data 'macro qui met en forme des graphes
DoEvents
Fich = Dir
Loop
Application.ScreenUpdating = True
End Sub


- Mon problème est le suivant : je voudrais sauvegarder les fichiers excel ouverts avec ma boucle de traitement du dossier source vers le dossier de réception. Entre les deux je leurs applique une macro (Data) qui mais en forme des graphes. Je n'arrive pas sauvegarder ces fichiers dans le dossier réception mais juste a remplacer ceux existants ce que je ne veux pas car j'ai besoin des originaux en cas de problème.
Indiquez moi une piste a prendre pour y arriver, s'il vous plait

Cordialement
 

Discussions similaires

Statistiques des forums

Discussions
312 505
Messages
2 089 066
Membres
104 015
dernier inscrit
kkgk