Here is my answer.
Purpose:
Take a list of columns and apply the Range.TextToColumns
method one by one as fast as possible.
Algorithm:
1. Create an array of needed columns;
2. Go through this array column by column and:
- 2.1 Check whether there is any data to the right;
- 2.2 Make sure to insert enough columns to preserve data on the right;
- 2.3 Apply Range.TextToColumns
method.
Tested on:
Range of 200 rows and 200 columns filled with "Sample Data"
text and randomly inserted "Sample Data Data Data Data Data"
text to test with different delimiters quantity. Used space as delimiter:

Code:
Sub SplitColumns()
Dim rToSplit() As Range, r As Range
Dim i As Long, j As Long, k As Long
Dim sht As Worksheet
Dim delimiter As String
Dim consDelimiter As Boolean
Dim start As Single, total As Single
Dim delimitersCount() As Long
'========================== TESTING STUFF =======================================
' set working sheet
Set sht = ThisWorkbook.Sheets("Sheet2")
' re-create sample data (it is changed on each macro run)
sht.Cells.Clear
ThisWorkbook.Sheets("Sheet2").Cells.Copy Destination:=sht.Cells(1, 1)
' timer for testing purposes - start point
start = Timer
'======================== END OF TESTING STUFF ===================================
' Set the delimiter
' I've used space
delimiter = " "
' assign a ConsecutiveDelimiter state
consDelimiter = False
Application.ScreenUpdating = False
'=================== CREATING A LIST OF COLUMNS FOR SPLIT ========================
' create an array of columns to be changed
' at this sample I take all 200 columns
' you have to assign your own range which is to be splitted
With sht
For i = .Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
' add columns to an array
If Not .Cells(1, i) = "" Then
ReDim Preserve rToSplit(j)
Set rToSplit(j) = Range(.Cells(1, i), .Cells(Rows.Count, i).End(xlUp))
j = j + 1
End If
Next
End With
'=============== END OF CREATING A LIST OF COLUMNS FOR SPLIT ======================
'============================= PERFORMING SPLIT ===================================
' go through each column in array
' from left to right, because
' there may be a need to insert columns
For j = LBound(rToSplit) To UBound(rToSplit)
' check whether there is any data on the right from the top cell of column
' note - I'm checking only ONE cell
If Not rToSplit(j).Cells(1, 1).Offset(0, 1) = "" Then
' creating another array:
' purpose - check cells in column
' and count quantity of delimiters in each of them
' quantity of delimiters = quantity of columns to insert
' in order not to overwrite data on the right
For Each r In rToSplit(j).Cells
ReDim Preserve delimitersCount(k)
delimitersCount(k) = UBound(Split(r.Text, delimiter))
k = k + 1
Next
' get the maximun number of delimiters (= columns to insert)
For i = 1 To WorksheetFunction.Max(delimitersCount)
' and insert this quantity of columns
rToSplit(j).Cells(1, 1).Offset(0, 1).EntireColumn.Insert
Next
' split the column, nothing will be replaced
rToSplit(j).TextToColumns Destination:=rToSplit(j).Cells(1, 1), ConsecutiveDelimiter:=consDelimiter, Tab:=False, Semicolon:=False, Comma:=False, _
Space:=False, Other:=True, OtherChar:=delimiter
Else
' here I just split column as there is no data to the right
rToSplit(j).TextToColumns Destination:=rToSplit(j).Cells(1, 1), ConsecutiveDelimiter:=consDelimiter, Tab:=False, Semicolon:=False, Comma:=False, _
Space:=False, Other:=True, OtherChar:=delimiter
End If
' clear the delimiters count array
Erase delimitersCount
' go to next column
Next
' done
'========================= END OF PERFORMING SPLIT ===================================
' timer for testing purposes - time difference in seconds
total = Timer - start
Debug.Print "Total time spent " & total & " seconds."
Application.ScreenUpdating = True
End Sub
Hope that helps.