Separate words in a single cell into multiple individual cells?

[alexli1219]

I have a few hundred cells with data in each cell that I am trying to separate into individual cells.

The data/words in the cell are formated like Something=Yes;something else=no. I am trying to take the "something" and put it in cell A1. The "yes" into cell B1, and so on and so forth. 

There are a few hundred of these and I am trying to find a way to separate it in a quicker manner rather than typing it all out.

[#2]

@alexli1219 

You may try the following code to split the data in the desired format.

Sub SplitData()
Dim wsData As Worksheet, wsOutput As Worksheet
Dim lr As Long, lc As Long, i As Long, ii As Long, j As Long
Dim x, y()
Dim str() As String

Application.ScreenUpdating = False

Set wsData = Worksheets("Sheet1")   'Sheet with raw data in Column A
lr = wsData.Cells(Rows.Count, 1).End(xlUp).Row

On Error Resume Next
Set wsOutput = Worksheets("Output") 'Outupt Sheet
wsOutput.Cells.Clear
On Error GoTo 0

If wsOutput Is Nothing Then
    Set wsOutput = Worksheets.Add(after:=wsData)
    wsOutput.Name = "Output"
End If

x = wsData.Range("A1:A" & lr).Value
ReDim y(1 To lr, 1 To 1)
For i = 1 To UBound(x, 1)
    str = Split(x(i, 1), ";")
    j = 1
    If UBound(y, 2) < (UBound(str) + 1) * 2 Then ReDim Preserve y(1 To lr, 1 To (UBound(str) + 1) * 2)
    For ii = LBound(str) To UBound(str)
        y(i, j) = Split(str(ii), "=")(0)
        y(i, j + 1) = Split(str(ii), "=")(1)
        j = j + 2
    Next ii
Next i

wsOutput.Range("A2").Resize(lr, UBound(y, 2)).Value = y
lc = wsOutput.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

For i = 1 To lc Step 2
    wsOutput.Cells(1, i) = "Name"
    wsOutput.Cells(1, i + 1) = "Trait"
Next i

wsOutput.UsedRange.Columns.AutoFit
wsOutput.Select

Application.ScreenUpdating = True
End Sub

Please click the button called "Split Data" on Sheet1 to run the code.