See if this helps. You have to change ColTable for the number of columns you
have, the length and starting position.
Sub fixwidth()
Const ForReading = 1, ForWriting = 2, _
ForAppending = 3
Const Folder = "c:\temp\test\"
Const StartPos = 0
Const ColWidth = 1
Dim ColTable(6, 2)
ColTable(0, StartPos) = 1
ColTable(0, ColWidth) = 10
ColTable(1, StartPos) = 11
ColTable(1, ColWidth) = 5
ColTable(2, StartPos) = 16
ColTable(2, ColWidth) = 8
ColTable(3, StartPos) = 24
ColTable(3, ColWidth) = 3
ColTable(4, StartPos) = 27
ColTable(4, ColWidth) = 6
ColTable(5, StartPos) = 33
ColTable(5, ColWidth) = 4
NumberColumns = UBound(ColTable)
Set fs = CreateObject("Scripting.FileSystemObject")
If Range("A1") = "" Then
RowCount = 1
Else
Lastrow = Range("A" & Rows.Count).End(xlUp).Row
RowCount = Lastrow
End If
First = True
Do
If First = True Then
Filename = Dir(Folder & "*.txt")
First = False
Else
Filename = Dir()
End If
If Filename <> "" Then
Set fin = fs.OpenTextFile(Folder & Filename, _
ForReading, TristateFalse)
Do While fin.AtEndOfStream <> True
readdata = fin.readline
For Colcount = 0 To (NumberColumns - 1)
Data = Mid(readdata, _
ColTable(Colcount, StartPos), _
ColTable(Colcount, ColWidth))
Cells(RowCount, Colcount + 1) = Data
Next Colcount
RowCount = RowCount + 1
Loop
fin.Close
End If
Loop While Filename <> ""
End Sub
