Import d'un Tableau Word dans Excel : format des dates modifié

Function ImportFichier() As Boolean
Dim sDisque As String
Dim NomFichierAOuvrir As Variant
Dim AppliWord As Word.Application
Dim bWordDejaOuvert As Boolean

    'Positionnement sur le disque et le répertoire du fichier (paramétré)
    On Error Resume Next 'On supprime le plantage en cas d'erreur
    sDisque = Left(Sheets("Mode d'Emploi").Range("RepertoireFichier").Value, 2)
    If Mid(sDisque, 2, 1) = ":" Then ChDrive sDisque
    ChDir Sheets("Mode d'Emploi").Range("RepertoireFichier").Value
    On Error GoTo 0 'On remet la gestion d'erreur normale
    
    'Saisie du nom du fichier à ouvrir
    NomFichierAOuvrir = Application.GetOpenFilename("Fichiers RTF (*.rtf), *.rtf", , "Sélectionnez le fichier word à ouvrir")
    If NomFichierAOuvrir = False Then
        ImportFichier = False
    Else
        ImportFichier = True
        Application.ScreenUpdating = False
        
        'On supprime tout dans l'onglet "Feuil1" de ce classeur
        ThisWorkbook.Sheets("Feuil1").Activate
        ActiveSheet.Range(Cells(1, 1), Cells(1, 1).SpecialCells(xlCellTypeLastCell)).EntireColumn.Delete
        
        '-------------------------------
        'Ouverture du fichier sous Word
        '-------------------------------
        bWordDejaOuvert = True
        On Error Resume Next
        Set AppliWord = GetObject(, "Word.Application")
        If Err.Number <> 0 Then
           Set AppliWord = CreateObject("Word.Application")
            bWordDejaOuvert = False
        End If
        Err.Clear ' Efface l'objet Err au cas où une erreur s'est produite.
        On Error GoTo 0
        'AppliWord.Activate
        AppliWord.Visible = True
        'AppliWord.Application.ScreenUpdating = False
        
        AppliWord.Documents.Open Filename:=NomFichierAOuvrir, _
            ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
            PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
            WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
            wdOpenFormatAuto
        'On se positionne sur la 2eme ligne
        AppliWord.Selection.MoveDown Unit:=wdLine, Count:=1
        'On selectionne tout jusqu'en bas
        AppliWord.Selection.EndKey Unit:=wdStory, Extend:=wdExtend
        'On copie ce qu'on a sélectionné
        AppliWord.Selection.Copy
        'On ferme le fichier rtf
        AppliWord.ActiveDocument.Close
        
        'On colle dans l'onglet "Feuil1" de ce fichier
        ThisWorkbook.Sheets("Feuil1").Activate
        Cells(1, 1).Select
        ActiveSheet.Paste
        'ActiveSheet.PasteSpecial Format:="Microsoft Word 8.0 Document Object"
        'ActiveSheet.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

        If Not bWordDejaOuvert Then AppliWord.Quit 'On ferme Word s'il n'était pas ouvert
        Set AppliWord = Nothing
                
        Application.ScreenUpdating = True

    End If

Sub TestParametresDate()
    MsgBox Application.International(xlDateOrder)
    
    'Ordre des éléments de la date :
    '0 = mois-jour-année
    '1 = jour-mois-année
    '2 = année-mois-jour
End Sub