VBA Copy & Paste Data Loop

Johnathannn

New Member
Joined
Oct 25, 2019
Messages
2
Hello,

I am looking for VB code to copy data from one sheet, and paste it onto another sheet in a different format.



Here is the current format:


ID
Amount 2014Amount 2015Amount 2016Amount 2017Amount 2018Total Previous Years Grand Total
001
2066.14438.736703.1910705.065785.523913.0829698.58
003
1166.122985.566071.158415.44548.0418638.2323186.27
187
779.83661.340001441.171441.17
010
1226.743155.466352.58693.075027.2619427.7724455.03
006
0002543.513297.142543.515840.65
011
181.28702.54463.386080.352715.4411427.5114142.95
007
1170.042952.285011.278757.774548.0417891.3622439.4
032
734.12325.953220.547080.433156.411361.0414517.44
<colgroup><col width="70" style="width: 53pt; mso-width-source: userset; mso-width-alt: 2560;"> <col width="88" style="width: 66pt; mso-width-source: userset; mso-width-alt: 3218;" span="5"> <col width="137" style="width: 103pt; mso-width-source: userset; mso-width-alt: 5010;"> <col width="79" style="width: 59pt; mso-width-source: userset; mso-width-alt: 2889;"> <tbody> </tbody>


Here is the desired format (on a new sheet):

IDYearsAmount
001
Amount 20142066.1
001
Amount 20154438.73
001
Amount 20166703.19
001
Amount 201710705.06
001
Amount 20185785.5
003
Amount 20141166.12
003
Amount 20152985.56
003
Amount 20166071.15
003
Amount 20178415.4
003
Amount 20184548.04
187
Amount 2014779.83
187
Amount 2015661.34
187
Amount 20160
187
Amount 20170
187
Amount 20180
010
Amount 20141226.74
010
Amount 20153155.46
010
Amount 20166352.5
010
Amount 20178693.07
010
Amount 20185027.26
006
Amount 20140
006
Amount 20150
006
Amount 20160
006
Amount 20172543.51
006
Amount 20183297.14
011
Amount 2014181.28
011
Amount 2015702.5
011
Amount 20164463.38
011
Amount 20176080.35
011
Amount 20182715.44
007
Amount 20141170.04
007
Amount 20152952.28
007
Amount 20165011.27
007
Amount 20178757.77
007
Amount 20184548.04
032
Amount 2014734.12
032
Amount 2015325.95
032
Amount 20163220.54
032
Amount 20177080.43
032
Amount 20183156.4
<colgroup><col width="70" style="width: 53pt; mso-width-source: userset; mso-width-alt: 2560;"> <col width="88" style="width: 66pt; mso-width-source: userset; mso-width-alt: 3218;"> <col width="64" style="width: 48pt;"> <tbody> </tbody>

Thanks!
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
7,975
Office Version
2007
Platform
Windows
Try this.
I assume the data begins in cell A1. And that in the 2 columns on the right you have totals and should not be considered.
Data on Sheet1, result on Sheet2, change data in red for your information.

Code:
Sub Copy_Paste_Loop()
  Dim a() As Variant, i As Long, b() As Variant, sh1 As Worksheet
  Dim lr As Long, lc As Long, j As Long, k As Long
  Set sh1 = Sheets("[COLOR=#ff0000]Sheet1[/COLOR]")
  lr = sh1.Range("A" & Rows.Count).End(xlUp).Row
  lc = sh1.Cells(1, Columns.Count).End(xlToLeft).Column - 2
  a = sh1.Range("A1", sh1.Cells(lr, lc)).Value
  ReDim b(1 To (lr - 1) * (lc - 1), 1 To 3)
  k = 1
  For i = 2 To UBound(a)
    For j = 2 To lc
      b(k, 1) = a(i, 1)
      b(k, 2) = a(1, j)
      b(k, 3) = a(i, j)
      k = k + 1
    Next
  Next
  Sheets("[COLOR=#ff0000]Sheet2[/COLOR]").Range("A2").Resize(UBound(b), 3).Value = b()
End Sub
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
7,975
Office Version
2007
Platform
Windows
I'm glad to help you. Thanks for the feedback.
 

Forum statistics

Threads
1,078,520
Messages
5,340,922
Members
399,399
Latest member
SravanaSandhya

Some videos you may like

This Week's Hot Topics

  • Problem with Radio Button's format control
    I am creating an employee evaluation template (a sample is below) Column A is the category Column B, C D, E and F will be ratings (unacceptable...
  • Last Display on userform to a Listbox
    [CODE=vba] lstdisplay.ColumnCount = 15 lstdisplay.RowSource = "A1:O600000" [/CODE] So when i do this it Displays everything on the sheet i am...
  • Rename and move files to a new location
    Dear all, I have an excel file with the following information. The actual file name is at column A but i want to rename it using the following...
  • Help with True/False Formula
    Hello! Am stumped how to fix this formula, in which my result returns 'True', but it should return False. =IF(AG2=True...
  • Clear extra characters from a provided range of cells
    Dear All, I have following code which gives me desired output to remove extra characters from a provided range. But it takes too much time when...
  • Help with Current and highest streaks
    Hi there, I've just joined the forum and this is my first post. I've already spent quite a bit of time searching the net and this forum for a...
Top