Sub Test()
Dim nRow As Long, nCol As Long
Dim rngRowFound As Range, rngResult As Range
Dim cell As Range, rngData As Range
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = ActiveWorkbook.Sheets(1)
Set ws2 = ActiveWorkbook.Sheets(2)
Set rngData = ws1.Range("B1", ws1.Cells(Rows.Count, "B").End(xlUp))
For Each cell In rngData
Select Case cell
Case ""
If cell.Offset(0, 1) Like "Test Cycle*" Then
nCol = CLng(Trim(Split(cell.Offset(0, 1), "Test Cycle")(1))) + 2
ws2.Cells(1, nCol) = cell.Offset(0, 1)
End If
Case Else
Set rngResult = ws2.Range("B2", ws2.Cells(Rows.Count, "B").End(xlUp))
If rngResult.row = 1 Then Set rngResult = ws2.Range("B2")
Set rngRowFound = rngResult.Find(cell.Value, LookAt:=xlWhole)
If rngRowFound Is Nothing Then
nRow = ws2.Cells(Rows.Count, "B").End(xlUp).Offset(1).row
With ws2.Cells(nRow, nCol - 1)
.Value = cell
.Offset(0, 1) = cell.Offset(0, 1)
End With
Else
With ws2.Cells(rngRowFound.row, nCol)
.Value = cell.Offset(0, 1)
End With
End If
End Select
Next
End Sub