Option Explicit
Sub Macro1()
Dim i As Long, j As Long, k As Long, x As Long
Dim lngStep As Long
Dim wsSrc As Worksheet, wsDestin As Worksheet
Dim xlnCalcMethod As XlCalculation
With Application
xlnCalcMethod = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
Set wsSrc = ThisWorkbook.Sheets("Sheet1") '<-Sheet name containing the raw data. Change to suit if necessary.
Set wsDestin = ThisWorkbook.Sheets("Sheet2") '<-Sheet name containing the raw data. Change to suit if necessary.
j = 3
k = wsSrc.Range("A:Q").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lngStep = 10
For i = j To k Step lngStep
If i = j Then
wsSrc.Range("A1:Q2").Copy Destination:=wsDestin.Range("A1")
wsSrc.Range("A" & i & ":Q" & i + lngStep - 1).Copy Destination:=wsDestin.Range("A" & j)
Else
x = wsDestin.Range("A:Q").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 5
wsSrc.Range("A1:Q2").Copy Destination:=wsDestin.Range("A" & x)
wsSrc.Range("A" & i & ":Q" & i + lngStep - 1).Copy Destination:=wsDestin.Range("A" & x + 2)
End If
Next i
With Application
.Calculation = xlnCalcMethod
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub