Transpose Data

[Dummy Excel]

hi all,
I put together the below code to transpose data from spreadsheets. It works ok for what I am, a novice at VB . This code worked fine as all the spreadsheets I used this for had all the same amount of columns, although now my spreadsheets have different amounts of columns which causes problems, ie sometimes there are up 60 columns.

Is there a way that I can adopt my original code, or is it easier with new code?

Sub Transpose_Data()
'
' This macro is to create Lowes range plan in a template
'
'aw = raw data
'nw = updated raw data

    'Copy first APN
    cnum = Range("A1").CurrentRegion.Columns.Count
    For i = 1 To cnum
    aw = ActiveSheet.Name
    Range([A2], [A2].End(xlDown)).Offset(0, 0).Copy
    If i = 1 Then
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Paste
        nw = ActiveSheet.Name
    Else
        Sheets(nw).Select
        Range("A1").End(xlDown).Offset(1, 0).PasteSpecial
    End If
    
    Sheets(aw).Select
    If i = 1 Then
        Range("B1").Copy
        Sheets(nw).Select
        Range("A1").End(xlDown).Offset(0, 1).Activate
        Range(Selection, Selection.End(xlUp)).PasteSpecial
        Sheets(aw).Select
    Else
        If i = 2 Then
            Range("c1").Copy
            Sheets(nw).Select
            Range("b1").End(xlDown).Offset(1, 0).PasteSpecial
            Range("b1").End(xlDown).Offset(0, 0).Copy
            Range("A1").End(xlDown).Offset(0, 1).Activate
            Range(Selection, Selection.End(xlUp)).PasteSpecial
            Sheets(aw).Select
            Else
            If i = 3 Then
                Range("D1").Copy
                Sheets(nw).Select
                Range("b1").End(xlDown).Offset(1, 0).PasteSpecial
                Range("b1").End(xlDown).Offset(0, 0).Copy
                Range("A1").End(xlDown).Offset(0, 1).Activate
                Range(Selection, Selection.End(xlUp)).PasteSpecial
                Sheets(aw).Select
                Else
                If i = 4 Then
                    Range("E1").Copy
                    Sheets(nw).Select
                    Range("b1").End(xlDown).Offset(1, 0).PasteSpecial
                    Range("b1").End(xlDown).Offset(0, 0).Copy
                    Range("A1").End(xlDown).Offset(0, 1).Activate
                    Range(Selection, Selection.End(xlUp)).PasteSpecial
                    Sheets(aw).Select
                    Else
                    If i = 5 Then
                        Range("F1").Copy
                        Sheets(nw).Select
                        Range("b1").End(xlDown).Offset(1, 0).PasteSpecial
                        Range("b1").End(xlDown).Offset(0, 0).Copy
                        Range("A1").End(xlDown).Offset(0, 1).Activate
                        Range(Selection, Selection.End(xlUp)).PasteSpecial
                        Sheets(aw).Select
                        Else
                        If i = 6 Then
                            Range("G1").Copy
                            Sheets(nw).Select
                            Range("b1").End(xlDown).Offset(1, 0).PasteSpecial
                            Range("b1").End(xlDown).Offset(0, 0).Copy
                            Range("A1").End(xlDown).Offset(0, 1).Activate
                            Range(Selection, Selection.End(xlUp)).PasteSpecial
                            Sheets(aw).Select
                            Else
                            If i = 7 Then
                                Range("H1").Copy
                                Sheets(nw).Select
                                Range("b1").End(xlDown).Offset(1, 0).PasteSpecial
                                Range("b1").End(xlDown).Offset(0, 0).Copy
                                Range("A1").End(xlDown).Offset(0, 1).Activate
                                Range(Selection, Selection.End(xlUp)).PasteSpecial
                                Sheets(aw).Select
                                Else
                                If i = 8 Then
                                    Range("I1").Copy
                                    Sheets(nw).Select
                                    Range("b1").End(xlDown).Offset(1, 0).PasteSpecial
                                    Range("b1").End(xlDown).Offset(0, 0).Copy
                                    Range("A1").End(xlDown).Offset(0, 1).Activate
                                    Range(Selection, Selection.End(xlUp)).PasteSpecial
                                    Sheets(aw).Select
                                    Else
                                    If i = 9 Then
                                        Range("J1").Copy
                                        Sheets(nw).Select
                                        Range("b1").End(xlDown).Offset(1, 0).PasteSpecial
                                        Range("b1").End(xlDown).Offset(0, 0).Copy
                                        Range("A1").End(xlDown).Offset(0, 1).Activate
                                        Range(Selection, Selection.End(xlUp)).PasteSpecial
                                        Sheets(aw).Select
                                        Else
                                        If i = 10 Then
                                            Range("K1").Copy
                                            Sheets(nw).Select
                                            Range("b1").End(xlDown).Offset(1, 0).PasteSpecial
                                            Range("b1").End(xlDown).Offset(0, 0).Copy
                                            Range("A1").End(xlDown).Offset(0, 1).Activate
                                            Range(Selection, Selection.End(xlUp)).PasteSpecial
                                            Sheets(aw).Select
                                            Else
                                            If i = 11 Then
                                                Range("L1").Copy
                                                Sheets(nw).Select
                                                Range("b1").End(xlDown).Offset(1, 0).PasteSpecial
                                                Range("b1").End(xlDown).Offset(0, 0).Copy
                                                Range("A1").End(xlDown).Offset(0, 1).Activate
                                                Range(Selection, Selection.End(xlUp)).PasteSpecial
                                                Sheets(aw).Select
                                                Else
                                                If i = 12 Then
                                                    Range("M1").Copy
                                                    Sheets(nw).Select
                                                    Range("b1").End(xlDown).Offset(1, 0).PasteSpecial
                                                    Range("b1").End(xlDown).Offset(0, 0).Copy
                                                    Range("A1").End(xlDown).Offset(0, 1).Activate
                                                    Range(Selection, Selection.End(xlUp)).PasteSpecial
                                                    Sheets(aw).Select
                                                    Else
                                                    If i = 13 Then
                                                        Range("N1").Copy
                                                        Sheets(nw).Select
                                                        Range("b1").End(xlDown).Offset(1, 0).PasteSpecial
                                                        Range("b1").End(xlDown).Offset(0, 0).Copy
                                                        Range("A1").End(xlDown).Offset(0, 1).Activate
                                                        Range(Selection, Selection.End(xlUp)).PasteSpecial
                                                        Sheets(aw).Select
                                                        Else
                                                        If i = 14 Then
                                                            Range("O1").Copy
                                                            Sheets(nw).Select
                                                            Range("b1").End(xlDown).Offset(1, 0).PasteSpecial
                                                            Range("b1").End(xlDown).Offset(0, 0).Copy
                                                            Range("A1").End(xlDown).Offset(0, 1).Activate
                                                            Range(Selection, Selection.End(xlUp)).PasteSpecial
                                                            Sheets(aw).Select
                                                            Else
                                                            If i = 15 Then
                                                                Range("P1").Copy
                                                                Sheets(nw).Select
                                                                Range("b1").End(xlDown).Offset(1, 0).PasteSpecial
                                                                Range("b1").End(xlDown).Offset(0, 0).Copy
                                                                Range("A1").End(xlDown).Offset(0, 1).Activate
                                                                Range(Selection, Selection.End(xlUp)).PasteSpecial
                                                                Sheets(aw).Select
                                                                Else
                                                                If i = 16 Then
                                                                    Range("Q1").Copy
                                                                    Sheets(nw).Select
                                                                    Range("b1").End(xlDown).Offset(1, 0).PasteSpecial
                                                                    Range("b1").End(xlDown).Offset(0, 0).Copy
                                                                    Range("A1").End(xlDown).Offset(0, 1).Activate
                                                                    Range(Selection, Selection.End(xlUp)).PasteSpecial
                                                                    Sheets(aw).Select
                                                                    Else
                                                                    If i = 17 Then
                                                                        Range("R1").Copy
                                                                        Sheets(nw).Select
                                                                        Range("b1").End(xlDown).Offset(1, 0).PasteSpecial
                                                                        Range("b1").End(xlDown).Offset(0, 0).Copy
                                                                        Range("A1").End(xlDown).Offset(0, 1).Activate
                                                                        Range(Selection, Selection.End(xlUp)).PasteSpecial
                                                                        Sheets(aw).Select
                                                                        Else
                                                                        If i = 18 Then
                                                                            Range("S1").Copy
                                                                            Sheets(nw).Select
                                                                            Range("b1").End(xlDown).Offset(1, 0).PasteSpecial
                                                                            Range("b1").End(xlDown).Offset(0, 0).Copy
                                                                            Range("A1").End(xlDown).Offset(0, 1).Activate
                                                                            Range(Selection, Selection.End(xlUp)).PasteSpecial
                                                                            Sheets(aw).Select
                                                                            If i = 19 Then
                                                                                Range("T1").Copy
                                                                                Sheets(nw).Select
                                                                                Range("b1").End(xlDown).Offset(1, 0).PasteSpecial
                                                                                Range("b1").End(xlDown).Offset(0, 0).Copy
                                                                                Range("A1").End(xlDown).Offset(0, 1).Activate
                                                                                Range(Selection, Selection.End(xlUp)).PasteSpecial
                                                                                Sheets(aw).Select
                                                                                End If
                                                                            End If
                                                                      End If
                                                                 End If
                                                            End If
                                                        End If
                                                    End If
                                                End If
                                            End If
                                        End If
                                    End If
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If
    If i = 1 Then
        Range([B2], [B2].End(xlDown)).Offset(0, 0).Copy
        Sheets(nw).Select
        Range("C1").PasteSpecial
    Else
        If i = 2 Then
            Range([C2], [C2].End(xlDown)).Offset(0, 0).Copy
            Sheets(nw).Select
            Range("C1").End(xlDown).Offset(1, 0).PasteSpecial
            Else
            If i = 3 Then
                Range([D2], [D2].End(xlDown)).Offset(0, 0).Copy
                Sheets(nw).Select
                Range("C1").End(xlDown).Offset(1, 0).PasteSpecial
                Else
                If i = 4 Then
                    Range([E2], [E2].End(xlDown)).Offset(0, 0).Copy
                    Sheets(nw).Select
                    Range("C1").End(xlDown).Offset(1, 0).PasteSpecial
                    Else
                    If i = 5 Then
                        Range([F2], [F2].End(xlDown)).Offset(0, 0).Copy
                        Sheets(nw).Select
                        Range("C1").End(xlDown).Offset(1, 0).PasteSpecial
                        Else
                        If i = 6 Then
                            Range([G2], [G2].End(xlDown)).Offset(0, 0).Copy
                            Sheets(nw).Select
                            Range("C1").End(xlDown).Offset(1, 0).PasteSpecial
                            Else
                            If i = 7 Then
                                Range([H2], [H2].End(xlDown)).Offset(0, 0).Copy
                                Sheets(nw).Select
                                Range("C1").End(xlDown).Offset(1, 0).PasteSpecial
                                Else
                                If i = 8 Then
                                    Range([I2], [I2].End(xlDown)).Offset(0, 0).Copy
                                    Sheets(nw).Select
                                    Range("C1").End(xlDown).Offset(1, 0).PasteSpecial
                                    Else
                                    If i = 9 Then
                                        Range([J2], [J2].End(xlDown)).Offset(0, 0).Copy
                                        Sheets(nw).Select
                                        Range("C1").End(xlDown).Offset(1, 0).PasteSpecial
                                        Else
                                        If i = 10 Then
                                            Range([K2], [K2].End(xlDown)).Offset(0, 0).Copy
                                            Sheets(nw).Select
                                            Range("C1").End(xlDown).Offset(1, 0).PasteSpecial
                                            Else
                                            If i = 11 Then
                                                Range([L2], [L2].End(xlDown)).Offset(0, 0).Copy
                                                Sheets(nw).Select
                                                Range("C1").End(xlDown).Offset(1, 0).PasteSpecial
                                                Else
                                                If i = 12 Then
                                                    Range([M2], [M2].End(xlDown)).Offset(0, 0).Copy
                                                    Sheets(nw).Select
                                                    Range("C1").End(xlDown).Offset(1, 0).PasteSpecial
                                                    Else
                                                    If i = 13 Then
                                                        Range([N2], [N2].End(xlDown)).Offset(0, 0).Copy
                                                        Sheets(nw).Select
                                                        Range("C1").End(xlDown).Offset(1, 0).PasteSpecial
                                                        Else
                                                        If i = 14 Then
                                                            Range([O2], [O2].End(xlDown)).Offset(0, 0).Copy
                                                            Sheets(nw).Select
                                                            Range("C1").End(xlDown).Offset(1, 0).PasteSpecial
                                                            Else
                                                            If i = 15 Then
                                                                Range([P2], [P2].End(xlDown)).Offset(0, 0).Copy
                                                                Sheets(nw).Select
                                                                Range("C1").End(xlDown).Offset(1, 0).PasteSpecial
                                                                Else
                                                                If i = 16 Then
                                                                    Range([Q2], [Q2].End(xlDown)).Offset(0, 0).Copy
                                                                    Sheets(nw).Select
                                                                    Range("C1").End(xlDown).Offset(1, 0).PasteSpecial
                                                                    Else
                                                                    If i = 17 Then
                                                                        Range([R2], [R2].End(xlDown)).Offset(0, 0).Copy
                                                                        Sheets(nw).Select
                                                                        Range("C1").End(xlDown).Offset(1, 0).PasteSpecial
                                                                        Else
                                                                        If i = 18 Then
                                                                            Range([S2], [S2].End(xlDown)).Offset(0, 0).Copy
                                                                            Sheets(nw).Select
                                                                            Range("C1").End(xlDown).Offset(1, 0).PasteSpecial
                                                                            Else
                                                                            If i = 19 Then
                                                                                Range([T2], [T2].End(xlDown)).Offset(0, 0).Copy
                                                                                Sheets(nw).Select
                                                                                Range("C1").End(xlDown).Offset(1, 0).PasteSpecial
                                                                            End If
                                                                        End If
                                                                    End If
                                                                End If
                                                            End If
                                                        End If
                                                    End If
                                                End If
                                            End If
                                        End If
                                     End If
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If
    Sheets(aw).Select
    If cnum - 1 = i Then GoTo FINISH
    Next i
    
FINISH:
    Application.CutCopyMode = False
End Sub

Additional info...
Column A = partnumber
Row 1 = store numbers

hope that is clear enough...
thanks
Sam

 

[patel45]

please upload a sample file for testing on a share site then paste the link here

 

[Dummy Excel]

have you got a link so that I can do that?
I did have it o

 

[Dummy Excel]

Excel 2007
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA
1		7243	7246	7247	7251	7571	7581	7583	7584	7585	7587	7598	7610	7617	7637	7695	7725	7741	7732	7773	7744	7746	7749	7752	7755	7763	7768
2	100405081	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1
3	900051118	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1
4	100266869	1	2	1	2	2	1	1	1	1	1	1	3	1	3	2	1	1	1	1	1	1	1	1	1	1	1
5	900051117	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1
6	100150170	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1
7	100149945	2	2	2	2	2	2	2	2	2	2	2	2	2	2	2	2	1	2	2	2	1	2	2	2	2	1
8	100266818	3	4	3	3	3	4	3	3	2	2	3	3	3	3	3	2	3	2	2	2	2	2	2	2	2	2
9	100664971	2	2	2	2	2	2	2	2	2	2	2	2	2	2	2	2	2	2	2	2	2	1	2	2	2	2
10	100683478	3	3	3	3	3	3	3	3	2	3	3	3	2	3	3	2	3	2	2	2	3	2	3	3	3	2
Con Summary (2)

Current Data
Column A = part number
Row 1 = store

the rest of the data is qty.

Transpose Data
column A = part number
Column B = store
Column C (till end) = qty

 

[Dummy Excel]

ADVERTISEMENT

anyone??

 

[Dummy Excel]

no one? i really need some help even just ideas on how to get this task achieved

 

[patel45]

ADVERTISEMENT

I'm avalable, but I need a sample file

 

[Dummy Excel]

Sample data is in post #4
If you want an excel file please advise how I can upload a file or PM me your email address

 

[JB_Scotland]

Can you summarise what you are trying to produce from your data?

Is it a table of part numbers in column a, stores in column b, quantity in column c?

100405081 7243 1
100405081 7246 1

etc

 

[Dummy Excel]

JB yes thats what im after