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!
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
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
 
Upvote 0
I'm glad to help you. Thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,213,510
Messages
6,114,044
Members
448,543
Latest member
MartinLarkin

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