Sub DivideWorksheet()
    Dim Lastrow As Long
    Dim r1 As Range
    Dim r2 As Range
    Dim wsData As Worksheet
    
    'Initalise Variables
    Set wsData = ActiveSheet
    Lastrow = Range("A" & Rows.Count).End(xlUp).Row
    Set r1 = Range("A" & Lastrow)
    
    'Create new worksheet for each block of characters
    'and Cut the data into them
    Do Until r1 = Range("A1")
        Set r1 = wsData.Range("A" & Lastrow)
        Set r2 = r1.End(xlUp)
        
        Worksheets.Add
        ActiveSheet.Name = r2.Value
        
        wsData.Activate
        
        Range(r1, r2).Cut Worksheets(r2.Value).Range("A1")
        Lastrow = Range("A" & Rows.Count).End(xlUp).Row
    Loop
    
    'reorder Worksheets
    For i = Worksheets.Count To 1 Step -1
        If Not Worksheets(i) Is wsData Then
            Worksheets(i).Move before:=wsData
        End If
    Next i
    
    'get rid of Object Variables
    Set r1 = Nothing
    Set r2 = Nothing
    Set wsData = Nothing
End Sub