'https://answers.microsoft.com/en-us/msoffice/forum/all/excel-vba-macro-to-import-large-txt-files-into/87150313-ea59-449a-8015-1a2e4a2bdf27
Option Explicit '<<< FIRST LINE
'Const Nmax As Long = 1048576 '<< max number of entries per sheet
Const Nmax As Long = 50000 '<< max number of entries per sheet
'Const N1 As Long = 900000 '<< split txt file every 900000 entries, change as needed / Nmax>=N1
Const N1 As Long = 10000 '<< split txt file every 900000 entries, change as needed / Nmax>=N1
Dim obj As Object
Dim oFl As Object
Dim sh As Worksheet, newSh As Worksheet
Dim t As Long, N As Long, x As Long, tt As Long, c As Long
Dim sFile As String
Dim sLine As String
Dim v As Variant, vv As Variant, v1 As Variant
Dim t1 As Double, t2 As Double
Sub Split_Large_TXT()
Dim MacroBook As Workbook
Dim MapSht As Worksheet
Dim TempSht As Worksheet
Dim MacroSht As Worksheet
Set MacroBook = ThisWorkbook
Set MapSht = MacroBook.Worksheets("Mapping")
Set MacroSht = MacroBook.Worksheets("Macro")
'Sep 11, 2016
If N1 > Nmax Then Exit Sub
t1 = Now
sFile = MapSht.Cells(TRng.Row, 4) & "\" & MapSht.Cells(TRng.Row, 5)
With Application
.Calculation = xlManual
End With
For Each sh In Sheets
If sh.Name Like "*Temp*" Then sh.Delete
Next
ReDim v(1 To N1, 1 To 1)
ReDim vv(1 To N1, 1 To 1)
t = 1
Set newSh = Sheets.Add(after:=ActiveSheet)
ActiveSheet.Name = "Temp" & t
Set obj = CreateObject("Scripting.FileSystemObject")
Set oFl = obj.OpenTextFile(sFile, 1)
N = 0
Do Until oFl.AtEndOfStream
sLine = oFl.ReadLine
N = N + 1
v(N, 1) = sLine
If N = N1 Then
Cells(1, 1).Resize(N1) = v
c = UBound(Split(Cells(1, 1).Value, vbTab))
SplitData c, v, vv, N1
ReDim v(1 To N1, 1 To 1)
ReDim vv(1 To N1, 1 To 1)
t = t + 1
Set newSh = Sheets.Add(after:=ActiveSheet)
ActiveSheet.Name = "Temp" & t
N = 0
End If
Loop
oFl.Close
Cells(1, 1).Resize(N1) = v
SplitData c, v, vv, N1
With Application
.Calculation = xlAutomatic
End With
t2 = Now
'MsgBox "time hh.mm.ss = " & Format(t2 - t1, "hh.mm.ss") & " to process " & MapSht.Cells(TRng.Row, 5)
End Sub
Sub SplitData(c As Long, v As Variant, vv As Variant, N1 As Long)
''''' On Error Resume Next
''''' For x = 0 To c
''''' tt = 1
''''' For Each v1 In v
''''' vv(tt, 1) = Split(v1, vbTab)(x)
''''' tt = tt + 1
''''' Next v1
''''' Cells(1, 1 + x).Resize(N1) = vv
''''' Next x
End Sub