Transpose Data

D

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
 
Sort by date Sort by votes
I have added headers to make it easier for vlookups
yes regarding subtotals, although need it transposed as we then run vlookups and other things to analyse the data

again, really appreciate your help and thoughts to make my working day easier :)
 
Upvote 0

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
You must log in or register to reply here.

Similar threads

N
  • Question
VBA Questions - Copying dynamic data from one tab to another and deleting filtered rows
Replies
1
Views
182
DanteAmor
DanteAmor
B
  • Solved
vba code to give next Sunday date for pasted data
Replies
2
Views
180
bh24524
B
P
  • Question
How to have hyperlinks pasted when data is copied
Replies
0
Views
84
Pophil
P
S
  • Question
How to streamline?
Replies
2
Views
166
sachavez
S
J
  • Question
VBA to select partial filename and go back and forth between two files to copy paste
Replies
1
Views
162
shknbk2
S

Forum statistics

Threads
1,214,819
Messages
6,121,729
Members
449,049
Latest member
MiguekHeka

Share this page

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