recopier extension fichier

Bonjour,

A partir d'excel, je voudrais sélectionner un fichier et l'enregistrer dans un endroit bien précis mais je n'arrive pas à garder l'extension du fichier. Est-ce que quelqu'un peut m'aider ?

Extraction de mon prog:

Dim Chemin As String

' Affectation des liens réseaux
Chemin = '\\\\Caracas\\Docs_metiers\\qualite\\en_cours\\'

' Référence à officialiser
Reference = InputBox('Quelle est la référence du document à officialiser ?' & Chr(13) & Chr(13), 'reference')

' Recherche de la référence dans le tableau
Search = Cells.Find(What:=Reference, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate

' Message d'aide
MsgBox 'Choisissez le document officiel de la référence' & ' ' & Reference & ' ' & ' ' & 'en cliquant sur ok'

' Fichier officiel
Fichier = Application.GetOpenFilename

If Fichier <> False Then

'Passage du statut de 'en attente' à 'en cours'
ActiveCell.Offset(0, 5) = 'En cours'


'Création du lien hypertexte dans excel
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
Chemin & Reference & 'extension', _
TextToDisplay:=Reference

'copie du fichier source dans chemin renommé
FileCopy Fichier, Chemin & Reference &'extension'
OldName = Fichier: NewName = Fichier & '.old'
Name OldName As NewName
End If


Merci de votre aide.
kinarius