Découpe d'un fichier txt en plusieurs Excel

Bonjour,
J'ai un fichier txt qui contient plus de 300 000 lignes et je veux le découper en plusieurs fichiers Excel.
J'y arrive sauf que le format des nombres n'est pas conservé.

Mes données sont des grands nombres (20 chiffres) donc ils se collent en format scientifique. Comment faire du collage spécial pour coller en foramt texte ?

Ci-joint ma macro:

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
 
Dim strFilePath As String, strFilename As String, vFullPath As Variant
Dim lngCounter As Long
Dim oConn As Object, oRS As Object, oFSObj As Object
 
    vFullPath = Application.GetOpenFilename("Text Files (*.txt),*.txt", , "Choisir le fichier à découper")
 
    If vFullPath = False Then Exit Sub
    Application.ScreenUpdating = False
 
    Set oFSObj = CreateObject("Scripting.FileSystemObject")
    strFilePath = oFSObj.GetFile(vFullPath).ParentFolder.Path
    strFilename = oFSObj.GetFile(vFullPath).Name
 
    Set oConn = CreateObject("ADODB.CONNECTION")
    oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
               "Data Source=" & strFilePath & ";" & _
               "Extended Properties=""text;HDR=No;FMT=Delimited"""
 
    Set oRS = CreateObject("AdoDb.Recordset")
 
    oRS.Open "SELECT * FROM " & strFilename, oConn, 3, 1, 1
    While Not oRS.EOF
        Sheets.Add
        ActiveSheet.Range("A1").CopyFromRecordset oRS, 65536
    Wend
    oRS.Close
    oConn.Close
    Application.ScreenUpdating = True

Merci pour votre aide