VBA to reorganize long column into multiple rows?

Hi all,

I'm semi familiar with macros but seem to be stumped by this issue and couldn't find anything online to help. I have a bunch of long (over 1000 rows each) excel columns that I need to reorganize into rows with common headings.

Currently, the data is organized as follows, in one column:

Plant name
Jay Enterprise
Plant Manager
John Jay
Date of closing
Aug-16
Plant size
250,000 Sq Ft
Employees
7500
Plant name
Jay Enterprise
Plant Manager
John Jay
Date of closing
Aug-16
Plant size
250,000 Sq Ft
Employees
7500
Plant name
Jay Enterprise
Plant Manager
John Jay
Date of closing
Aug-16
Plant size
250,000 Sq Ft
Employees
7500

Is there a macro I can use to split up the single column into multiple columns all beginning with the heading 'Plant Name'? As a side note, not all of the data is the same number of cells. Some of the columns would have to be 21 cells, others 18, etc etc., so I cannot use the offset function.

Any help would be greatly appreciated!

In real life the plant names will all be different. I'll provide an example of the actual data below:

Plant Name:
Central Investment Corp
SIC:
2086
Address:
1820 Nussbaum Parkway
Manufactured:
Soft drink bottling
City, state, zip:
Mansfield, Oh 44906
# people:
40
Facility size, sq ft:
100,000
Established:
1949
Plant Manager:
Mike O
Closing:
5-Oct
Production Manager:
Bill S
Plant Name:
Bob’s Candies
SIC:
2064
Address:
1315 W Oakridge Drive
Manufactured:
Hard candy
City, state, zip:
Albany, Ga 31707


Ideally, I would have a column for each plant, so plant name is the delimiter.

Maybe:

Sub bpenick()
Dim i As Long, y, x As Long, textrange As Range
ReDim y(1 To Range("A" & Rows.Count).End(3).row)
For i = UBound(y) To LBound(y) Step -1
    If Cells(i, "A") = "Plant name" Then Cells(i, "A").Insert xlDown
Next i
For Each textrange In Columns(1).SpecialCells(2).Areas
x = Cells(2, Columns.Count).End(xlToLeft).Column + 1
    addr = textrange.Address(False, False)
    Range(addr).Cut Cells(2, x)
Next textrange
Rows(1).Delete
Columns(1).Delete
End Sub

Thank you all! The formulas work pretty well. I was able to pretty much reformat the data as I wanted.

Best,

Ben

You're welcome. Glad to help out and thanks for the feedback.