Problem executing VBA code

[sofas]

I am trying to transfer data from Sheet 1 to Sheet 2, paste every 10 separate rows, calculate the sum of the value of column M for every 10 rows in row 11, and write the word TOTAL under column J, inserting 5 empty rows between each range and the other.

[CODE] WSdest.Range("A" & fin) = WSdata.Range("A" & x)

 WSdest.Range("B" & fin) = WSdata.Range("B" & x)

 WSdest.Range("C" & fin) = WSdata.Range("C" & x)


 *

'Is it possible to shorten only these rows instead of
'writing the names of the 16 columns that currently exist?[/CODE]

 

[sofas]

FYI - Going on holiday and won't be able to look at this for a couple of weeks.

Happy holiday, another chance. Sorry for the inconvenience. Thank you for your help

 

[Skyybot]

Option Explicit
Option Base 1

Sub CopyRows()
Dim wb As Workbook, wsData As Worksheet, wsDest As Worksheet, cRng As Range, lRow As Long, i As Long, y As Long, x As Long
Application.ScreenUpdating = False
Set wb = ThisWorkbook: Set wsData = wb.Sheets("Sheet1"): Set wsDest = wb.Sheets("Sheet2")
lRow = wsData.Rows.End(xlDown).Row
Set cRng = wsData.Range("A1:P" & lRow)
i = 1
y = 4
x = 3
cRng.Rows(1).Copy wsDest.Cells(1, 1)
cRng.Rows(2).Copy wsDest.Cells(3, 1)
Application.CutCopyMode = False
Do Until x > lRow
    Do Until i > 10
        If IsEmpty(cRng.Range("A" & x)) Then Exit Do
        cRng.Rows(x).Copy wsDest.Cells(y, 1)
        Application.CutCopyMode = False
        i = i + 1: y = y + 1: x = x + 1
    Loop
    wsDest.Range("J" & y) = "Total": wsDest.Cells(y, "M").FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
    wsDest.Cells(y, "O").FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)": wsDest.Cells(y, "P").FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
    wsDest.Range("J" & y & ":P" & y).Interior.Color = 65535
    i = 1
    y = y + 2
    cRng.Rows(1).Copy wsDest.Cells(y, 1)
    y = y + 2
    cRng.Rows(2).Copy wsDest.Cells(y, 1)
    Application.CutCopyMode = False
    y = y + 1
Loop
Application.ScreenUpdating = True
End Sub

 

[sofas]

Option Explicit
Option Base 1

Sub CopyRows()
Dim wb As Workbook, wsData As Worksheet, wsDest As Worksheet, cRng As Range, lRow As Long, i As Long, y As Long, x As Long
Application.ScreenUpdating = False
Set wb = ThisWorkbook: Set wsData = wb.Sheets("Sheet1"): Set wsDest = wb.Sheets("Sheet2")
lRow = wsData.Rows.End(xlDown).Row
Set cRng = wsData.Range("A1:P" & lRow)
i = 1
y = 4
x = 3
cRng.Rows(1).Copy wsDest.Cells(1, 1)
cRng.Rows(2).Copy wsDest.Cells(3, 1)
Application.CutCopyMode = False
Do Until x > lRow
Do Until i > 10
If IsEmpty(cRng.Range("A" & x)) Then Exit Do
cRng.Rows(x).Copy wsDest.Cells(y, 1)
Application.CutCopyMode = False
i = i + 1: y = y + 1: x = x + 1
Loop
wsDest.Range("J" & y) = "Total": wsDest.Cells(y, "M").FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
wsDest.Cells(y, "O").FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)": wsDest.Cells(y, "P").FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
wsDest.Range("J" & y & ":P" & y).Interior.Color = 65535
i = 1
y = y + 2
cRng.Rows(1).Copy wsDest.Cells(y, 1)
y = y + 2
cRng.Rows(2).Copy wsDest.Cells(y, 1)
Application.CutCopyMode = False
y = y + 1
Loop
Application.ScreenUpdating = True
End Sub
[/CODE]

Thank you, you excelled. I wish you a happy holiday