Aquí te dejo un ejemplo, pero tienes que modificarlo según tus necesidades ya que me parece que debes investigar por tu cuenta.
Sub ImportLongLines()
' Importar un archivo de texto con >256 columnas de datos
Dim ImpRange As Range
Dim r As Long, c As Integer
Dim CurrLine As Long
Dim Data As String, Char As String, Txt As String
Dim i As Integer
Dim CurrSheet As Worksheet
' Crear un nuevo libro de trabajo con una hoja
Workbooks.Add xlWorksheet
Open ThisWorkbook.Path & "\longfile.txt" For Input As #1
r = 0
c = 0
Set ImpRange = ActiveWorkbook.Sheets(1).Range("A1")
Application.ScreenUpdating = False
' Leer la primera línea, e insertar nuevas hojas si es necesario
CurrLine = CurrLine + 1
Line Input #1, Data
For i = 1 To Len(Data)
Char = Mid(Data, i, 1)
' ¿Estamos fuera de columnas?
If c <> 0 And c Mod 256 = 0 Then
Set CurrSheet = ActiveWorkbook.Sheets.Add(after:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count))
Set ImpRange = CurrSheet.Range("A1")
c = 0
End If
' ¿Fin del campo?
If Char = "," Then
ImpRange.Offset(r, c) = Txt
c = c + 1
Txt = ""
Else
' Saltar caracteres
If Char <> Chr(34) Then _
Txt = Txt & Mid(Data, i, 1)
' ¿Fin de línea?
If i = Len(Data) Then
ImpRange.Offset(r, c) = Txt
c = c + 1
Txt = ""
End If
End If
Next i
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Leer los datos restantes
c = 0
CurrLine = 1
Set ImpRange = ActiveWorkbook.Sheets(1).Range("A1")
r = r + 1
Do Until EOF(1)
Set ImpRange = ActiveWorkbook.Sheets(1).Range("A1")
CurrLine = CurrLine + 1
Line Input #1, Data
Application.StatusBar = "Processing line " & CurrLine
For i = 1 To Len(Data)
Char = Mid(Data, i, 1)
' ¿Estamos fuera de columnas?
If c <> 0 And c Mod 256 = 0 Then
c = 0
Set ImpRange = ImpRange.Parent.Next.Range("A1")
End If
' Final de campo
If Char = "," Then
ImpRange.Offset(r, c) = Txt
c = c + 1
Txt = ""
Else
' Saltar caracteres
If Char <> Chr(34) Then _
Txt = Txt & Mid(Data, i, 1)
' ¿Final de línea?
If i = Len(Data) Then
ImpRange.Offset(r, c) = Txt
c = c + 1
Txt = ""
End If
End If
Next i
c = 0
Set ImpRange = ActiveWorkbook.Sheets(1).Range("A1")
r = r + 1
Loop
' Ordenar
Close #1
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub
[email protected]