Sub MoveData()

Set sht = Worksheets.Add(after:=Sheets(Sheets.Count))

RowCount = 1
NewRowCount = 1
With Sheets("Sheet1")
Do While .Range("A" & RowCount) < ""
Header = .Range("A" & RowCount)
LastCol = _
.Cells(RowCount, Columns.Count).End(xlToLeft).Column
For ColCount = 2 To LastCol
If .Cells(RowCount, ColCount) < "" Then
sht.Range("A" & NewRowCount) = Header
sht.Range("B" & NewRowCount) = _
.Cells(RowCount, ColCount)
NewRowCount = NewRowCount + 1
End If
Next ColCount
RowCount = RowCount + 1
Loop
End With

End Sub


"Utkarsh" wrote:

Hi

I have data organised as:

A 1 2 3
B 4 5
C 6 7
I want to rearrange it as:
A 1
A 2
A 3
B 4
B 5
C 6
C 7

The standard transpose doesn't help. I guess this will have to be done
programatically. Can someone help?

Thanks
Utkarsh