Sub Multi_Column_Text_To_Column()

Dim selected_range, selected_range_individual_column() As Range
Dim one_to_how_many_columns, col_count As Long

Set selected_range = Selection
On Error GoTo err_occured:

'-------------------------------------------------------------------------------------
'one_to_how_many_columns value  = Number of colums that a single column should be split into
'Provide a sufficiently large value so as to prevent overlaps and overwriting
'-------------------------------------------------------------------------------------
one_to_how_many_columns = 10



Application.DisplayAlerts = False
If Not (TypeName(selected_range) = "Range") Then End
ReDim selected_range_individual_column(selected_range.Columns.Count - 1) As Range

For col_count = LBound(selected_range_individual_column) To UBound(selected_range_individual_column)
    Set selected_range_individual_column(col_count) = selected_range.Columns(col_count + 1)
    'MsgBox "Value = " & selected_range_individual_column(col_count).Cells(1, 1).Value
Next col_count

'Begin Text to Column conversion process by starting from Right and proceeding left
For col_count = UBound(selected_range_individual_column) To LBound(selected_range_individual_column) Step -1

    If Application.WorksheetFunction.CountIf(selected_range_individual_column(col_count), "<>") = 0 Then GoTo next_loop:
 
    '-------------------------------------------------------------------------------------
   'DataType = xlDelimited or xlFixedWidth
   '-------------------------------------------------------------------------------------
   'If Data Type = xlDelimited then one has to specify the delimiting characters
   '           Change the boolean values for various delimiting characters such as :
   '           ConsecutiveDelimiter, Tab, Semicolon, Comma, Space and Other tokens as per requirement
   'If Data Type = xlFixedWidth then one has to specify the widths of the fields using the FieldInfo Array.
   '           This example specifies three widths for splitting into five columns with each array
   '           bit containing the cumulative sum of chars till the beginning of each word
   '           You will have to edit and modify (add more or delete) these values as per need
   '-------------------------------------------------------------------------------------

    selected_range_individual_column(col_count).TextToColumns _
    Destination:=selected_range.Cells(selected_range.Row, one_to_how_many_columns * col_count + 1), _
    DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=True, _
    Tab:=False, _
    Semicolon:=False, _
    Comma:=False, _
    Space:=True, _
    Other:=False, _
    FieldInfo:=Array( _
        Array(0, 1), _
        Array(3, 1), _
        Array(6, 1), _
        Array(12, 1), _
        Array(17, 1) _
        ), _
        TrailingMinusNumbers:=True
       
next_loop:
Next col_count
err_occured:
Application.DisplayAlerts = True
End Sub