Sub nouveau_classeur()
Dim chemin As String
Dim nom As String
'Trouve le nom du classeur actif
nom = ActiveWorkbook.Name
'Trouve le chemin du fichier actuel, puis le nom inscrit dans la cellule "nom_fichier"
'Ce chemin complet sera le nom du nouveau fichier
chemin = ThisWorkbook.Path & "\" & Range("nom_fichier") & " " & Date & ".xlsx"
'Crée un nouveau fichier
Workbooks.Add
'Enregistre sous le fichier
ActiveWorkbook.SaveAs Filename:=chemin _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
'Copie les données de "Feuil5" du premier classer vers "Feuil1" du nouveau classeur
Workbooks(nom).Feuil5.UsedRange.Copy ActiveWorkbook.Feuil1.Range("A3") '--> Bug ICI!!!
'Enregistre
ActiveWorkbook.Save
'Ferme le classeur
ActiveWorkbook.Close
'Réactive le premier classeur
Workbooks(nom).Activate
End Sub