urgent transpose macro needed -

Sub ReorientDAta()
Dim sh as worksheet, sh2 as worksheet
Dim rw2 as Long, i as Long, j as Long
set sh = Activesheet
set sh2 = Worksheets.Add(after:=worksheets(worksheet.count))
rw2 = 1
i = 1
do while not isempty(sh.cells(i,1))
j = 2
do while not isempty(sh.cells(i,j))
sh2.cells(rw2,1) = sh.cells(i,1)
sh2.cells(rw2,2) = sh.cells(i,j)
j = j + 1
rw2 = rw2 + 1
Loop
i = i + 1
Loop
End Sub

--
Regards,
Tom Ogilvy


"barkiny" wrote:

>
> Column A B C
> Company1 2005 2006
> Company2 2003 2004 2002
> ..
> ..
> ..
>
> i need a macro so that it would transpose the columns and write the
> company names beside each date
>
> it would like:
>
> Company 1 2005
> Company 1 2006
> Company 2 2003
> Company 2 2004
> Company 2 2002
>

thank you very much

the code
Worksheets.Add(after:=worksheets(worksheet.count))

works when
Worksheets.Add(after:=worksheets(worksheets.count))