Transpose columns to rows inserting lines & skipping bla

[alykat]

Hi there,

Would anybody be able to help me out with this one:

I have worksheet in which certain rows will need to be transposed into columns. Extra lines containing the information in the first row will need to be inserted, and any blanks skipped.

Let me show you what I mean:

******** ******************** ************************************************************************>

Microsoft Excel - Book1.xls ___Running: xl2000 : OS = Windows Windows 2000
(F)ile (E)dit (V)iew (I)nsert (O)ptions (T)ools (D)ata (W)indow (H)elp (A)bout
A9 =
	A	B	C	D	E	F
1	What*I*have:	*	*	*	*	*
2	*	*	*	*	*	*
3	Name	Location	Transaction*A	Transaction*B	Transaction*C	Transaction*D
4	Mr*Jones	London	A	B	C	D
5	Mr*Smith	Blackpool	*	B	C	D
6	Mrs*Roberts	Liverpool	*	*	C	*
7	Miss*Smith	Manchester	A	*	C	D
8	*	*	*	*	*	*
9	What*I*would*like:	*	*	*	*	*
10	*	*	*	*	*	*
11	Name	Location	Transaction	*	*	*
12	Mr*Jones	London	A	*	*	*
13	Mr*Jones	London	B	*	*	*
14	Mr*Jones	London	C	*	*	*
15	Mr*Jones	London	D	*	*	*
16	Mr*Smith	Blackpool	B	*	*	*
17	Mr*Smith	Blackpool	C	*	*	*
18	Mr*Smith	Blackpool	D	*	*	*
19	Mrs*Roberts	Liverpool	C	*	*	*
20	Miss*Matthews	Manchester	A	*	*	*
21	Miss*Matthews	Manchester	C	*	*	*
22	Miss*Matthews	Manchester	D	*	*	*
Sheet1 *

[HtmlMaker 2.42] To see the formula in the cells just click on the cells hyperlink or click the Name box
PLEASE DO NOT QUOTE THIS TABLE IMAGE ON SAME PAGE! OTHEWISE, ERROR OF JavaScript OCCUR.

Thanks again!

[onlyadrafter]

Hello,

Does the following code suit your needs?

Sub ROWS_TO_COLUMNS()
For MY_ROWS = 1 To Range("A65536").End(xlUp).Row
    MY_NAME = Range("A" & MY_ROWS).Value
    MY_LOCATION = Range("B" & MY_ROWS).Value
    For MY_TR_NO = 3 To 7
        MY_TRANS = Range("A1").Offset(MY_ROWS - 1, MY_TR_NO - 1).Value
    If MY_TRANS <> "" Then
        Range("H65536").End(xlUp).Offset(1, 0) = MY_NAME
        Range("I65536").End(xlUp).Offset(1, 0) = MY_LOCATION
        Range("J65536").End(xlUp).Offset(1, 0) = MY_TRANS
    End If
        MY_TRANS = ""
    Next MY_TR_NO
Next MY_ROWS
End Sub

You will need to change cell refs as required.

[alykat]

Thanks, that's great.
I've been trying this on another worksheet. Some of the columns work fine, but others are not being copied onto the new lines. Could you let me know what's wrong with the following code?:

Sub ROWS_TO_COLUMNS()
For MY_ROWS = 1 To Range("A65536").End(xlUp).Row
MY_CYBORG_PAY_NO = Range("A" & MY_ROWS).Value
MY_SAP_POSITION_NUMBER = Range("B" & MY_ROWS).Value
MY_NAME = Range("C" & MY_ROWS).Value
MY_SAP_POSITION_TITLE = Range("D" & MY_ROWS).Value
MY_SAP_ORG_UNIT_ID = Range("E" & MY_ROWS).Value
MY_SAP_ORG_UNIT_NAME = Range("F" & MY_ROWS).Value
MY_OBJ_CODE = Range("G" & MY_ROWS).Value
MY_OBJ_DESC = Range("H" & MY_ROWS).Value
MY_FUNCTIONAL_AREA = Range("I" & MY_ROWS).Value
For MY_TR_NO = 10 To 36
MY_TRANS = Range("A1").Offset(MY_ROWS - 1, MY_TR_NO - 1).Value
If MY_TRANS <> "" Then
Range("AL65536").End(xlUp).Offset(1, 0) = MY_CYBORG_PAY_NO
Range("AM65536").End(xlUp).Offset(1, 0) = MY_SAP_POSITION_NUMBER
Range("AN65536").End(xlUp).Offset(1, 0) = MY_NAME
Range("AO65536").End(xlUp).Offset(1, 0) = MY_SAP_POSITION_TITLE
Range("AP65536").End(xlUp).Offset(1, 0) = MY_SAP_ORG_UNIT_ID
Range("AQ65536").End(xlUp).Offset(1, 0) = MY_SAP_ORG_UNIT_NAME
Range("AR65536").End(xlUp).Offset(1, 0) = MY_OBJ_CODE
Range("AS65536").End(xlUp).Offset(1, 0) = MY_OBJ_DESC
Range("AT65536").End(xlUp).Offset(1, 0) = MY_FUNCTIONAL_AREA
Range("AU65536").End(xlUp).Offset(1, 0) = MY_TRANS

End If
MY_TRANS = ""
Next MY_TR_NO
Next MY_ROWS
End Sub


The columns that are not copying correctly are SAP POSITION NUMBER, SAP POSITION TIORG UNIT ID and SAP ORG UNIT NAME.