[Toutes versions] Macro pour copier coller un fichier excel

Bonjour

Je réaliser des modifications sur un fichier,mais jai besoin de garder l'original intact.

Du coup j'ai pensé a faire une macro qui me permettra de copier le fichier excel en entier dans un nouveau fichier automatiquement ( plusieurs Feuilles), et l'enregistrer sur un autre dossier.

Voici le code ( copier à partir d'un autre forum) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
 
Public Sub macro_test_1()
Dim nouveau As Variant
Dim cherche As String
Dim fichier As String
Dim chemin As String
chemin = "C:\Users\XXX\Documents\"      '  à remplacer par ton répertoire
nouveau = "C:\Users\XXX\Documents\Dos_Perso\"                '  à remplacer par ton nouveau répertoire
cherche = "Fichier_test_1.xlsm"           '  à remplacer par ton classeur
fichier = Dir(chemin)              '  recherche premier
Do
    If fichier = cherche Then      '  fichier trouvé
        Workbooks.Open chemin & fichier    '  fichier ouvert
                                                      ' demande du nouveau nom
        nouveau = Application.GetSaveAsFilename(nouveau, _
              fileFilter:="classeurs (*.xls), *.xls", _
              Title:="fichier_suivi")
        If nouveau <> False Then            '  fichier saisi ?
            ActiveWorkbook.SaveAs nouveau   ' sauvegarde nouveau
            MsgBox "Sauvé sous " & nouveau  ' message
            ActiveWorkbook.Close            ' fermeture
        Else
            MsgBox "Classeur non sauvegardé"
        End If
    Exit Do  ' sortie procédure
    End If
 
fichier = Dir                '  recherche fichier suivant
 
Loop
 
End Sub

La macro ne donne pas le résultat attendu. Est ce que vous voyez peut ce trouver le problème?

Merci.

Le fichier sur lequel je travail s'appel Fichier_test_1.xlsm