Copy to column if cell matches certain value

[jb1180]

I have a 3 row spreadsheet that needs to be separated into multiple columns. Row 1 is the unique value. Row 2 will become the column name. Row 3 contains the data for the column. Ultimately will result in about 200 columns.

Is there a good formula that would accomplish this? Thanks in advance.

Sample Current format

[TABLE="width: 500"]
<tbody>[TR]
[TD]PART1[/TD]
[TD]MANUFACTURER[/TD]
[TD]NAME[/TD]
[/TR]
[TR]
[TD]PART1[/TD]
[TD]MANUFACTURER PART NUMBER[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]PART2[/TD]
[TD]MANUFACTURER[/TD]
[TD]NAME[/TD]
[/TR]
[TR]
[TD]PART2[/TD]
[TD]MANUFACTURER PART NUMBER[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]PART3[/TD]
[TD]MANUFACTURER[/TD]
[TD]NAME[/TD]
[/TR]
[TR]
[TD]PART3[/TD]
[TD]MANUFACTURER PART NUMBER[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]PART4[/TD]
[TD]MANUFACTURER[/TD]
[TD]NAME[/TD]
[/TR]
[TR]
[TD]PART4[/TD]
[TD]MANUFACTURER PART NUMBER[/TD]
[TD]4[/TD]
[/TR]
</tbody>[/TABLE]

Sample Desired output

[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]MANUFACTURER PART NUMBER[/TD]
[TD]MANUFACTURER[/TD]
[/TR]
[TR]
[TD]PART1[/TD]
[TD]1[/TD]
[TD]NAME[/TD]
[/TR]
[TR]
[TD]PART2[/TD]
[TD]2[/TD]
[TD]NAME[/TD]
[/TR]
[TR]
[TD]PART3[/TD]
[TD]3[/TD]
[TD]NAME[/TD]
[/TR]
[TR]
[TD]PART4[/TD]
[TD]4[/TD]
[TD]NAME[/TD]
[/TR]
</tbody>[/TABLE]

****** id="cke_pastebin" style="position: absolute; top: 134px; width: 1px; height: 1px; overflow: hidden; left: -1000px;">[TABLE="width: 500"]
<tbody>[TR]
[TD]MANUFACTURER[/TD]
[/TR]
</tbody>[/TABLE]

 

[AFPathfinder]

I believe this is beyond a formulas type solution. You'll need a macro like this:

Sub Zipper()
    Dim i As Integer
    Dim finalRow As Integer
    
    Range("A1").EntireRow.Insert
    
    finalRow = Cells(Rows.Count, 1).End(xlUp).Row
    Range("B1").Value = "Manufacturer Part Number"
    Range("C1").Value = "Manufacturer"
    
    For i = 2 To finalRow
        If Cells(i, 1).Value = "" Then
            Exit For
        End If
        
        Cells(i, 2).Value = Cells(i, 3).Value
        Cells(i, 3).Value = Cells(i + 1, 3).Value
        Range("A" & i + 1).EntireRow.Delete
    Next i
    
    MsgBox "The macro has finished."
End Sub