How to use VBA code to transpose and copy values X Number of Times
Category: [Excel] Demo Available
How to use VBA code to transpose and copy values X Number of Times
Requirement:
The user would like to copy the values in column A and B in sheet 1 a certain number of times (the count of days in from column C to the far right) as well as transposing.
The Date needs to be in a column as well. Finally, the dollar value should be in the column for the appropriately identified record.
It is kind of hard to explain, so the user has posted some sample illustrative data below as well as a file that shows what the user needs to create (The user has only copied down two of the IDs but need all in the list in sheet 1).
Sheet 1 - Original Data
| ID | CODE | 29-Jun-18 | 28-Jun-18 | 27-Jun-18 | 26-Jun-18 | 25-Jun-18 | 22-Jun-18 | 21-Jun-18 | 20-Jun-18 | 19-Jun-18 | 18-Jun-18 | 15-Jun-18 |
| 370707 | Z404199A | 26,667,118.00 | 18,069,283.00 | 13,891,299.00 | 104,681,561.00 | 188,020,746.00 | 199,854,190.00 | 37,984,272.00 | 167,687,934.00 | 55,069,802.00 | 74,723,821.00 | 145,896,197.00 |
| 383057 | Z370076A | 36,018,253.00 | 180,459,316.00 | 43,985,113.00 | 26,826,758.00 | 189,445,567.00 | 142,444,787.00 | 95,937,850.00 | 128,601,506.00 | 67,460,593.00 | 157,599,316.00 | 75,377,394.00 |
| 26160 | Z481239A | 80,661,392.00 | 6,175,130.00 | 16,755,656.00 | 101,777,889.00 | 103,832,268.00 | 172,820,301.00 | 21,447,399.00 | 58,362,008.00 | 85,894,866.00 | 198,374,389.00 | 124,893,401.00 |
| 468883 | Z136813A | 134,100,710.00 | 69,428,984.00 | 41,992,088.00 | 162,069,991.00 | 97,073,170.00 | 153,246,262.00 | 25,650,568.00 | 60,901,434.00 | 48,342,434.00 | 172,748,888.00 | 161,314,201.00 |
| 142631 | Z135200A | 121,409,683.00 | 26,268,290.00 | 182,422,121.00 | 100,877,599.00 | 64,855,837.00 | 62,423,977.00 | 20,479,210.00 | 56,973,418.00 | 190,674,155.00 | 84,238,099.00 | 8,196,560.00 |
| 171639 | Z358015A | 195,568,451.00 | 56,587,043.00 | 115,602,002.00 | 35,589,683.00 | 177,131,383.00 | 18,222,129.00 | 46,451,562.00 | 71,956,343.00 | 135,313,461.00 | 179,214,355.00 | 68,986,453.00 |
Sheet 2 - Final Data
| ID | CODE | Date | Value |
| 370707 | Z172821A | 6/29/2018 | 26,667,118.00 |
| 370707 | Z172821A | 6/28/2018 | 18,069,283.00 |
| 370707 | Z172821A | 6/27/2018 | 13,891,299.00 |
| 370707 | Z172821A | 6/26/2018 | 104,681,561.00 |
| 370707 | Z172821A | 6/25/2018 | 188,020,746.00 |
| 370707 | Z172821A | 6/22/2018 | 199,854,190.00 |
| 370707 | Z172821A | 6/21/2018 | 37,984,272.00 |
| 370707 | Z172821A | 6/20/2018 | 167,687,934.00 |
| 370707 | Z172821A | 6/19/2018 | 55,069,802.00 |
| 370707 | Z172821A | 6/18/2018 | 74,723,821.00 |
| 370707 | Z172821A | 6/15/2018 | 145,896,197.00 |
| 370707 | Z172821A | 6/14/2018 | 26,281,302.00 |
| 370707 | Z172821A | 6/13/2018 | 17,820,382.00 |
| 370707 | Z172821A | 6/12/2018 | 152,371,477.00 |
| 370707 | Z172821A | 6/11/2018 | 129,667,278.00 |
| 370707 | Z172821A | 6/8/2018 | 10,122,098.00 |
| 370707 | Z172821A | 6/7/2018 | 33,468,435.00 |
| 370707 | Z172821A | 6/6/2018 | 68,750,640.00 |
| 370707 | Z172821A | 6/5/2018 | 31,784,305.00 |
| 370707 | Z172821A | 6/4/2018 | 130,661,247.00 |
| 370707 | Z172821A | 6/1/2018 | 58,955,392.00 |
| 383057 | Z240757A | 6/29/2018 | 36,018,253.00 |
| 383057 | Z240757A | 6/28/2018 | 180,459,316.00 |
| 383057 | Z240757A | 6/27/2018 | 43,985,113.00 |
| 383057 | Z240757A | 6/26/2018 | 26,826,758.00 |
| 383057 | Z240757A | 6/25/2018 | 189,445,567.00 |
| 383057 | Z240757A | 6/22/2018 | 142,444,787.00 |
Solution:
Code:
Sub Copy_Rows()
Application.ScreenUpdating = False
Dim LastRow As Long
LastRow = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim lCol As Long
lCol = Range("IV1").End(xlToLeft).Column
Dim x As Long
For x = 2 To LastRow
Sheets("Sheet1").Cells(x, 1).Resize(, 2).Copy Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(lCol - 2, 2)
Sheets("Sheet1").Range("C1").Resize(, lCol - 2).Copy
Sheets("Sheet2").Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Sheets("Sheet1").Range("C" & x).Resize(, lCol - 2).Copy
Sheets("Sheet2").Cells(Rows.Count, "D").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues, Transpose:=True
Next x
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Obtained from the OzGrid Help Forum.
Solution provided by Mumps.
See also: Index to Excel VBA Code and Index to Excel Freebies and Lesson 1 - Excel Fundamentals and Index to how to… providing a range of solutions and Index to new resources and reference sheets
See also:
| How to create excel VBA to transpose single row to multiple columns |
| How to transpose single column into multiple columns and rows |
| How to use VBA to transpose data from single column to rows |
Click here to visit our Free 24/7 Excel/VBA Help Forum where there are thousands of posts you can get information from, or you can join the Forum and post your own questions.