I want to automatically divide the string entered in one cell with different colors in Excel and replace it with a new cell.

Sub button 1_Click()
    Dimcell Asrange
    Set cell= range ("A1")
    Dim color As Integer 'Current color index
    Dimrow As Integer' Current Output Leading Number
    Dim start As Integer 'Current Color Start Location
    color=cell.Characters(start:=1, Length:=1).Font.ColorIndex' First Color
    row = 2
    start = 1
    
    Fori=1 Tocell.Characters.Count
        Dimch As Characters
        Dimc As Integer
        'Check the character color one character at a time
        Setch=cell.Characters (start:=i, length:=1)
        c=ch.Font.ColorIndex
        If c<>color Then
            'If the current string is different from the previous string, output up to the previous string.
            Cells(row,1).Value=cell.Characters(start, i-start).Text
            Cells(row,1).Font.ColorIndex=color
            'Update variable with current string
            start=i
            row=row+1
            color=c
        End If
    Next
    'Output up to last string
    Cells(row,1).Value=cell.Characters(start, i-start).Text
    Cells(row,1).Font.ColorIndex=color
End Sub