XL 2016 Extraction fichier .txt trop important

[auverland]

Bonjour à tous et bonne et heureuse année

J'ai des fichiers .txt qui sont trop important pour les importer avec excel 2016 (fichier de 600M)

Avec le code suivant j'arrive à tronçonner un fichier en utilisant le nb maxi de ligne possible

Pouvez-vous me dire si il est possible avec ce bout de code de créer des nouveaux fichiers pour chacune des feuilles et qui reprendrait le nom du fichier d'origine avec un indice ? ( _001.txt type split)

Merci d'avance

Sub Extraction_V2()
Dim Repertoire As String, Fichier As String
Dim strFullName As Variant
Dim Cn As Object, Rs As Object
'Sélection du ficher
strFullName = Application.GetOpenFilename("Fichiers textes (*.txt),*.txt", , _
    "Sélectionnez un fichier :")
'On sort si aucun fichier n'est sélectionné
If strFullName = False Then Exit Sub
Application.ScreenUpdating = False
Fichier = Dir(strFullName)
Repertoire = Left(strFullName, Len(strFullName) - (Len(Fichier) + 1))
'Connection
Set Cn = CreateObject("ADODB.Connection")
Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & Repertoire & ";" & _
    "Extended Properties=""text;HDR=Yes;FMT=Delimited"""
'Requete
Set Rs = CreateObject("ADODB.Recordset")
Rs.Open "SELECT * FROM [" & Fichier & "]", Cn, 3, 1, 1
'boucle sur le résultat de la requete
While Not Rs.EOF
    'Ajout Feuille
    Worksheets.Add
    'Ecriture des données dans la feuille
    '65536 spécifie le nombre de lignes par feuille
    ActiveSheet.Range("A1").CopyFromRecordset Rs, 10000000
Wend
Rs.Close
Set Rs = Nothing
Cn.Close
Set Cn = Nothing
Application.ScreenUpdating = True
End Sub

 

[Staple1600]

Bonsoir le fil, le forum

Je te laisse adapter ce code
(il suffit de changer le type de fichier et d'ajouter l'incrément du préfixe)

Sub Eclater_WBK()
Dim strPath As String
strPath = ThisWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Sheets
    ws.Copy
    ActiveWorkbook.SaveAs Filename:=strPath & "\" & ws.Name & ".xlsx"
    ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

EDITION: Comme j'ai fini par faire l'adaptation (et histoire de pas gâcher), je poste

Sub Eclater_WBK2TXT()
Dim strPath As String, NomC$, j&
strPath = ThisWorkbook.Path
NomC = Split(ThisWorkbook.Name, ".")(0)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
j = 1
For Each ws In ThisWorkbook.Sheets
   ws.Copy
   ActiveWorkbook.SaveAs Filename:=strPath & "\" & NomC & Format(j, "_000") & ".txt", FileFormat:=xlText
   ActiveWorkbook.Close False
j = j + 1
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub