Découper fichier TXT en pls fichiers Excel

Résolu
05steph Messages postés 19 Date d'inscription   Statut Membre Dernière intervention   -  
05steph Messages postés 19 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

J'ai un fichier .txt qui contient 300 000 lignes. J'ai besoin de le mettre sous excel.
Comment faire pour créer automatiquement un premier fichier avec les 65 536 premières lignes, un autre avec les 65536 suivantes ... et appeler ces fichiers "Fichier 1", "Fichier 2" ...

Je voudrais un truc style une macro parce que ça m'arrive souvent.

Merci beaucoup pour votre aide
A voir également:

1 réponse

Réponse 1 / 1
05steph Messages postés 19 Date d'inscription   Statut Membre Dernière intervention   7
 
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: 
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
2