Sub blah()
'Sheets("Before").Copy After:=Sheets(Sheets.Count)'only used to copy the sheet to preserve original
Set myRange = Intersect(Columns("B:J"), ActiveSheet.UsedRange)
Application.DisplayAlerts = False
For colm = myRange.Columns.Count To 1 Step -1
  If colm <> 2 Then
    myRange.Columns(colm + 1).EntireColumn.Insert
    'Let Excel decide what to do with with strings that look like numbers:
    myRange.Columns(colm).TextToColumns DataType:=xlDelimited, Other:=True, OtherChar:=Chr(10), FieldInfo:=Array(Array(1, 1), Array(2, 1))
    
    'or:
  
    'Treat the numbers as text and keep them as such (this will preserve any leading zeroes - you might do this if the numbers are account numbers or numbers you neveer need to do arithmetic on:
    'myRange.Columns(colm).TextToColumns DataType:=xlDelimited, Other:=True, OtherChar:=Chr(10), FieldInfo:=Array(Array(1, 2), Array(2, 2))
  End If
Next colm
Columns("B").Insert
myRange.Offset(, -2).Resize(, 1).TextToColumns , DataType:=xlDelimited, Other:=True, OtherChar:="T", FieldInfo:=Array(Array(1, 5), Array(2, 1))
Application.DisplayAlerts = True
Range("A1:S1").Value = Array("Date", "Time", "01 Fonds", "01 Fonds 2", "02 Mbres", "03 YUPR", "03 YUPR 2", "04 JLMY", "04 JLMY 2", "05 RuffY", "05 RuffY 2", "06 LeFY", "06 LeFY 2", "07 TatiaY", "07 TatiaY 2", "08 MediaY", "08 MediaY 2", "09 RTFY", "09 RTFY 2")
End Sub