Самоделкин
Ботаник

Стол;Стул;Табуретка
Ромашка;Василек

Sub X()
    Dim cel As Range
    Dim rgn As Range
    Dim str As String
    
    Set rgn = Cells( 1 ,  1 ).CurrentRegion
    Set rgn = rgn.Offset( 1 ,  0 ).Resize(rgn.Rows.Count -  1 , rgn.Columns.Count)
    
    Cells( 1 ,  3 ).Value = Cells( 1 ,  1 ).Value
    Cells( 1 ,  4 ).Value = Cells( 1 ,  2 ).Value
    
    For Each cel In rgn.Columns( 1 ).Cells
        str = str & ";" & cel.Offset( 0 ,  1 )
        If cel.Value <> cel.Offset( 1 ,  0 ).Value Then
            cel.Offset( 0 ,  2 ).Value = cel.Value
            cel.Offset( 0 ,  3 ).Value = Mid(str,  2 )
            str = ""
        End If
    Next
     
    [C:C].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    [D:D].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Columns("A:B").Delete Shift:=xlToLeft
    
    Cells( 1 ,  1 ).CurrentRegion.Columns.AutoFit
    Range("A1:B1").AutoFilter
End Sub