VBA / Macro Copy, Paste, Loop

Cad67

New Member
Joined
Jun 1, 2020
Messages
2
Office Version
  1. 365
Platform
  1. Windows
Hi All

A little help please for a complete VBA / Macro novice.

I am trying to automate the coping of data from one sheet to another whereby the macro I have takes all the data in the first data row (row 2) of sheet 1 ("Standard report - Items"), copies this to a new sheet, then selectively cuts data from that line and places in in the row below at column AC until I finish with 5 rows of data (multiple columns). Once that is complete I need to then repeat this same action for line 3 on ("Standard report - Items") and so on until there is no more data to copy over.

I know this looks inelegant and there's probably a much easier way to do it but this is how I got to do the first row of cut and pasting. This is a monthly task on a number of reports, all copied and pasted manually at the moment but there must be an easier way, right? This is the output I'm looking for. We start with one row that has 69 data fields but I need to split it thus,


1591018237187.png


then go to line 2 (or item2 as shown above) of the data source and drop below the first data set and so on.


Over to the experts and thanks in advance to anybody that can help.



Sheets("Standard report - Items").Select
Rows("2:2").Select
Selection.Copy
Sheets("Sheet5").Select
Rows("2:2").Select
ActiveSheet.Paste
Application.Goto Reference:="R2C29"
Range("AC2:BQ2").Select
Application.CutCopyMode = False
Selection.Cut
Range("AC3").Select
ActiveSheet.Paste
Selection.Cut Destination:=Range("S3:BG3")
Range("AC3").Select
Range("AC3:BG3").Select
Selection.Cut
Range("S4").Select
ActiveSheet.Paste
Range("AC4").Select
Range("AC4:AW4").Select
Selection.Cut
Range("S5").Select
ActiveSheet.Paste
Range("AC5:AM5").Select
Selection.Copy
Application.CutCopyMode = False
Selection.Cut
Range("S6").Select
ActiveSheet.Paste
Range("A7").Select
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
try this code which should be quick and efficient by using variant arrays:
VBA Code:
Sub test()
Dim outarr() As Variant

With Worksheets("Standard report - Items")
' load all the data into a variant array
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
inarr = Range(.Cells(1, 1), .Cells(lastrow, 69))
End With
' define an output array of suitable size
ReDim outarr(1 To 5 * lastrow, 1 To 29)
colno = 18
rowno = 2
' loop through all input rows
For i = 2 To lastrow
  ' copy the first line
   For j = 1 To 28
   outarr(rowno, j) = inarr(i, j)
   Next j
   ' copy the next 4 lines
   For j = 1 To 4
    ' in batches of 10
     For k = 1 To 10
       outarr(rowno + j, colno + k) = inarr(i, 18 + j * 10 + k)
     Next k
   Next j
   ' add the odd value at the end
   outarr(rowno + 4, 29) = inarr(i, 69)
   ' increment the row count
   rowno = rowno + 5
Next i
' write the output to sheet 5
With Worksheets("Sheet5")
Range(.Cells(1, 1), .Cells(lastrow * 5, 29)) = outarr
End With
End Sub
 
Upvote 0
try this code which should be quick and efficient by using variant arrays:

This is fabulous, thank you so very much - you've just saved me hours of manual cut and pasting - truly awesome, thank you.


All the very best
 
Upvote 0

Forum statistics

Threads
1,224,744
Messages
6,180,697
Members
452,994
Latest member
Janick

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