XL 2013 Transformer le format Texte en Date suite à un transfert automatique via VBA

[MgLina]

Bonjour le Forum!

J'avais crée une discussion pour importer et transférer les données automatiquement via VBA, et suite à des recherches dans le forum, j'ai réussi à combiner les différentes solutions pour résoudre mon problème.

Par contre, j'ai rencontré deux problèmes:
1. Le transfert de données automatisé fonctionne bien, mais je n'ai pas le bon format. Par exemple, les données en date sont transférées en Texte (colonne H, I, J, K).
2. Le temps d'exécution est long!, ça me prend plus de 2 mins pour ce tableau de test, mais le fichier que je dois travailler peut avoir plus de milliers de lignes. Je ne veut pas passer des heures pour faire le transfert. SVP! Help!

Voici le code que j'ai utilisé:

Sub Importer()
Dim nom$, WBKSource As Workbook
With Application.FileDialog(msoFileDialogOpen)
   .Title = "Veuillez sélectionner le fichier"
    .Filters.Clear
    .Filters.Add "RECAP", "*.xlsX*, *.Xlsm*, *.Xls*"
    .AllowMultiSelect = False
        If .Show <> 0 Then
        nom = .SelectedItems(1)
            Set WBKSource = Workbooks.Open(nom)
           With WBKSource
                .ActiveSheet.Copy Before:=ThisWorkbook.Sheets(1)
                .Close False
            End With
        Else
        MsgBox "Aucun fichier sélectionné": Exit Sub
        End If
End With

End Sub
Sub Transférer()
Application.ScreenUpdating = False
DL1 = Sheets("Gantt Chart").Range("A6000").End(xlUp).Row
DL2 = Sheets("Gantt Chart (2)").Range("A6000").End(xlUp).Row
Set F = Sheets("Gantt Chart (2)")
With Sheets("Gantt Chart")
    For L = 5 To DL2
        If Application.CountIf(.Range("AA:AA"), F.Cells(L, "AA")) = 0 Then ' Le code n'existe pas
            DL1 = DL1 + 1                                               ' Incrément N° ligne de transfert
            Copie DL1, L
        Else
            Lx = Application.Match(F.Cells(L, "AA"), .Range("AA:AA"), 0)   ' Ligne où se trouve le code
            Copie Lx, L
        End If
    Next L
End With
End Sub
Sub Copie(Li1, Li2) ' Transfert cellules
    Set F = Sheets("Gantt Chart (2)")
    With Sheets("Gantt Chart")
        .Cells(Li1, "A") = F.Cells(Li2, "A")
        .Cells(Li1, "B") = F.Cells(Li2, "B")
        .Cells(Li1, "C") = F.Cells(Li2, "C")
        .Cells(Li1, "D") = F.Cells(Li2, "D")
        .Cells(Li1, "E") = F.Cells(Li2, "E")
        .Cells(Li1, "F") = F.Cells(Li2, "F")
        .Cells(Li1, "G") = F.Cells(Li2, "G")
        .Cells(Li1, "H") = F.Cells(Li2, "H")
        .Cells(Li1, "I") = F.Cells(Li2, "I")
        .Cells(Li1, "J") = F.Cells(Li2, "J")
        .Cells(Li1, "K") = F.Cells(Li2, "K")
        .Cells(Li1, "L") = F.Cells(Li2, "L")
        .Cells(Li1, "M") = F.Cells(Li2, "M")
        .Cells(Li1, "N") = F.Cells(Li2, "N")
        .Cells(Li1, "Z") = F.Cells(Li2, "Z")
        .Cells(Li1, "AA") = F.Cells(Li2, "AA")
    End With
End Sub

Pourriez-vous svp m'aider à améliorer le code ? Voici la capture d'écran une fois que j'ai fait le transfert. J'aimerais que les lignes transférées 28 à 32 aient le même format que les autres lignes. Et je voudrais réduire le temps d'exécution de transfert.

Je vous remercie énormément!

 

[Staple1600]

Bonsoir

Esssaie avec CDate
[...]
.Cells(Li1, "H") = CDate(F.Cells(Li2, "H"))
etc...
etc...
[...]

 

[MgLina]

Bonsoir

Esssaie avec CDate
[...]
.Cells(Li1, "H") = CDate(F.Cells(Li2, "H"))
etc...
etc...
[...]

Bonjour, merci pour la réponse rapide,

Malheuresement,ça ne marche pas, j'ai le message d'erreur suivant :

 

[MgLina]

J'ai réussi, il faut remplacer:
.Cells(Li1, "H") = Format((F.Cells(Li2, "H")),"dd/mm/yy")

Par contre, quelqu'un sait comment réduire le temps d'exécution de commande Transférer ?

Merci !