Sub ConvertToTable()

'
'convert text to table
'
    Dim LastRow               As Long
    Dim ws                    As Worksheet
    
    Application.ScreenUpdating = False

    Range("A:A").Copy
    Workbooks.Add
    Set ws = ActiveSheet
    With ws
        .Paste
        Application.CutCopyMode = False
        Selection.TextToColumns Destination:=ws.Range("A1"), DataType:=xlDelimited, _
                                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                                Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="""", _
                                FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 9), Array(4, 1), Array(5, 9), _
                                                 Array(6, 1), Array(7, 9), Array(8, 1), Array(9, 9), Array(10, 1), Array(11, 9), _
                                                 Array(12, 1), Array(13, 9), Array(14, 1), Array(15, 9), Array(16, 1), Array(17, 1))
        .Range("A:B").EntireColumn.Insert
        LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
        ' add to columns date

        .Range("B1").Value2 = "Date2"
        With .Range("B2:B" & LastRow)
            .FormulaR1C1 = "=IF(RC[1]<>"""",TEXT(RC[1],""0000-00-00"")+0,"""")"
            .NumberFormat = "dd-mmm-yy"
        End With
        With .Sort
            With .SortFields
                .Clear
                .Add Key:=ws.Range("B1"), SortOn:=xlSortOnValues, _
                     Order:=xlAscending, DataOption:=xlSortNormal
            End With
            .SetRange ws.Range("B2:L100")
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        
        ' add to columns number from 1 forward
        .Range("A1").Value2 = "no"
        With .Range("A2")
            .Value2 = 1

            .AutoFill Destination:=ws.Range("A2:A" & LastRow), Type:=xlFillSeries
        End With
        
        'delete empty rows
        On Error Resume Next
        .Columns("D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        Application.ScreenUpdating = True
    End With

End Sub