VBA / Macro Copy, Paste, Loop

[Cad67]

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,

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

 

[offthelip]

try this code which should be quick and efficient by using variant arrays:

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

 

[Cad67]

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