I looked at your data and didn't realize the differences between the code I
provided and then posting I responded to yesterday. Try these imporvements

Sub Transpose()

Set SourceSht = Sheets("sheet1")
Set DestSht = Sheets("sheet2")
With DestSht
.Range("A1") = "Op #"
.Range("B1") = "OP Desc"
.Range("C1") = "Hazard"
End With

With SourceSht
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
SourceRow = 2
DestRow = 2
Do While .Range("A" & SourceRow) < ""
'set Copyrange to equal columns A - C
Set CopyRange = _
.Range("A" & SourceRow & ":B" & SourceRow)
For Colcount = 3 To LastCol
If .Cells(SourceRow, Colcount) < "" Then
CopyRange.Copy _
Destination:=DestSht.Range("A" & DestRow)
Hazard = .Cells(SourceRow, Colcount).Value
DestSht.Range("C" & DestRow) = Hazard
DestRow = DestRow + 1
End If
Next Colcount
SourceRow = SourceRow + 1
Loop
End With
End Sub




"Jeff Gross" wrote:

Thanks alot Joel.

I was actually looking at that post before posting my own. The code you
provided is putting blank rows in when there is a blank in the cell of a
particular column. I could do a subsequent re-sort and that would remove
them but if I could just get the code to not put a blank row in when there is
a blank cell, that would be very helpful.

Jeff

"Joel" wrote:

this is code I wrote yesterday for another posting. I modified yesterdays
code becasue you only have two columns that need to be copied to every row
and yesterdays posting had 3 columns that need to be copied to every row.
the code is copying the data from sheet1 and putting the results in sheet2.
The macro runs faster if you put the data into a new worksheet.

Sub Transpose()

Set SourceSht = Sheets("sheet1")
Set DestSht = Sheets("sheet2")
With DestSht
.Range("A1") = "ID"
.Range("B1") = "Surname"
.Range("C1") = "Name"
.Range("D1") = "Choises"
End With

With SourceSht
SourceRow = 2
DestRow = 2
Do While .Range("A" & SourceRow) < ""
'set Copyrange to equal columns A - C
Set CopyRange = _
.Range("A" & SourceRow & ":B" & SourceRow)
ColCount = 3
Do While .Cells(SourceRow, ColCount) < ""
CopyRange.Copy _
Destination:=DestSht.Range("A" & DestRow)
Choice = .Cells(SourceRow, ColCount).Value
DestSht.Range("C" & DestRow) = Choice
DestRow = DestRow + 1
ColCount = ColCount + 1
Loop
SourceRow = SourceRow + 1
Loop
End With
End Sub





"Jeff Gross" wrote:

I have several columns of data such as follows:

A B C D E
Op # Op Desc Mechanical Electrical Fire
10 Desc #1 mech 1 elect 1
10 Desc #2 elect 2 fire 1
20 Desc #3 mech 2 fire 2
20 Desc #4 mech 3 elect 3

The end result must be a sort of the data by Op # and then by the hazard
category (columns C-E) with each hazard category on it's own row as follows:

10 Desc #1 mech 1
10 Desc #1 elect 1
10 Desc #2 elect 2
10 Desc #2 fire 1
20 Desc #3 mech 2
20 Desc #3 fire 2
20 Desc #4 mech 3
20 Desc #4 elect 3

Any ideas? There could be up to 300 original versions of the rows of data
to sort this way.

Thanks for any help.