Transpose Data

Dummy Excel

Well-known Member
Joined
Sep 21, 2005
Messages
1,004
Office Version
  1. 2019
  2. 2010
  3. 2007
Platform
  1. Windows
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?
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
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
have you got a link so that I can do that?
I did have it o
 
Upvote 0

Excel 2007
ABCDEFGHIJKLMNOPQRSTUVWXYZAA
172437246724772517571758175837584758575877598761076177637769577257741773277737744774677497752775577637768
210040508111111111111111111111111111
390005111811111111111111111111111111
410026686912122111111313211111111111
590005111711111111111111111111111111
610015017011111111111111111111111111
710014994522222222222222221222122221
810026681834333433223333323222222222
910066497122222222222222222222212222
1010068347833333333233323323222323332
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
 
Upvote 0
no one? i really need some help even just ideas on how to get this task achieved
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top