Option Explicit 
 
Sub CreateFixedWidthFile(strFile As String, ws As Worksheet, s() As Integer) 
    Dim i As Long, j As Long 
    Dim strLine As String, strCell As String 
     
     'get a freefile
    Dim fNum As Long 
    fNum = FreeFile 
     
     'open the textfile
    Open strFile For Output As fNum 
     'loop from first to last row
     'use 2 rather than 1 to ignore header row
    For i = 1 To ws.Range("a65536").End(xlUp).Row 
         'new line
        strLine = "" 
         'loop through each field
        For j = 0 To UBound(s) 
             'make sure we only take chars up to length of field (may want to output some sort of error if it is longer than field)
            strCell = Left$(ws.Cells(i, j + 1).Value, s(j)) 
             'add on string of spaces with length equal to the difference in length between field length and value length
            strLine = strLine & strCell & String$(s(j) - Len(strCell), Chr$(32)) 
        Next j 
         'write the line to the file
        Print #fNum, strLine 
    Next i 
     'close the file
    Close #fNum 
     
End Sub 
 
 
 'for example the code could be called using:
 
Sub CreateFile() 
    Dim sPath As String 
    sPath = Application.GetSaveAsFilename("", "Text Files,*.txt") 
    If LCase$(sPath) = "false" Then Exit Sub 
     'specify the widths of our fields
     'the number of columns is the number specified in the line below +1
    Dim s(6) As Integer 
     'starting at 0 specify the width of each column
    s(0) = 21 
    s(1) = 9 
    s(2) = 15 
    s(3) = 11 
    s(4) = 12 
    s(5) = 10 
    s(6) = 186 
     'for example to use 3 columns with field of length 5, 10 and 15 you would use:
     'dim s(2) as Integer
     's(0)=5
     's(1)=10
     's(2)=15
     'write to file the data from the activesheet
    CreateFixedWidthFile sPath, ActiveSheet, s 
End Sub