Help with Optimizing Slow Working cut/paste data macro

Hi All,

I'm looking for a way to increase the speed of a macro I've already written. The concept is to change the format of a very large sales report into something that can be manipulated into a pivot table.

The below code does work, but it runs rather slowly on the actual report I'm using it on at work (which is > 150k lines), so wondered if maybe there was a better way of doing it. I had considered an array, but after researching I am unsure how I would write the specific array values that I need, which are essentially always the 8 rows beneath the start row.

Essentially this macro cuts rows and transplants them onto a parent row which is linked to the account number. I have attached a before and after spreadsheet, as hopefully that will show you what I'm trying to achieve.

Here is the code:

Sub Macro1()
Dim lastrow As Long
Dim startrow As Long
Dim lastcol As Long
Dim pastecol As Long
startrow = 2
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
pastecol = Cells(startrow, Columns.Count).End(xlToLeft).Column + 1
For i = 2 To lastrow
If Cells(i, 2).Value = "SALES" And Cells(i, 3).Value = "2017" Then
Range(Cells(i, 4), Cells(i, 16)).Offset(1, 0).Cut Destination:=Range(Cells(startrow, pastecol), Cells(startrow, pastecol + 13))
Range(Cells(i, 4), Cells(i, 16)).Offset(2, 0).Cut Destination:=Range(Cells(startrow, pastecol + 13), Cells(startrow, pastecol + 26))
Range(Cells(i, 4), Cells(i, 16)).Offset(3, 0).Cut Destination:=Range(Cells(startrow, pastecol + 26), Cells(startrow, pastecol + 39))
Range(Cells(i, 4), Cells(i, 16)).Offset(4, 0).Cut Destination:=Range(Cells(startrow, pastecol + 39), Cells(startrow, pastecol + 52))
Range(Cells(i, 4), Cells(i, 16)).Offset(5, 0).Cut Destination:=Range(Cells(startrow, pastecol + 52), Cells(startrow, pastecol + 65))
Range(Cells(i, 4), Cells(i, 16)).Offset(6, 0).Cut Destination:=Range(Cells(startrow, pastecol + 65), Cells(startrow, pastecol + 78))
Range(Cells(i, 4), Cells(i, 16)).Offset(7, 0).Cut Destination:=Range(Cells(startrow, pastecol + 78), Cells(startrow, pastecol + 91))
Range(Cells(i, 4), Cells(i, 16)).Offset(8, 0).Cut Destination:=Range(Cells(startrow, pastecol + 91), Cells(startrow, pastecol + 104))
startrow = startrow + 9
End If
Next i
YearOne = Cells(2, 3).Value
YearTwo = Cells(3, 3).Value
YearThree = Cells(4, 3).Value
headerlastcol = Cells(1, Columns.Count).End(xlToLeft).Column + 1
For j = headerlastcol To pastecol + 91
Range(Cells(1, 4), Cells(1, 16)).Copy Destination:=Range(Cells(1, j), Cells(1, j + 12))
j = j + 12
Next j
finallastcol = Cells(1, Columns.Count).End(xlToLeft).Column
For k = 4 To finallastcol
If k > 3 And k < 17 Then
Cells(1, k).Value = "SALES " & Cells(1, k).Value & " " & YearOne
ElseIf k > 16 And k < 30 Then
Cells(1, k).Value = "SALES " & Cells(1, k).Value & " " & YearTwo
ElseIf k > 29 And k < 43 Then
Cells(1, k).Value = "SALES " & Cells(1, k).Value & " " & YearThree
ElseIf k > 42 And k < 56 Then
Cells(1, k).Value = "RETURNS " & Cells(1, k).Value & " " & YearOne
ElseIf k > 55 And k < 69 Then
Cells(1, k).Value = "RETURNS " & Cells(1, k).Value & " " & YearTwo
ElseIf k > 68 And k < 82 Then
Cells(1, k).Value = "RETURNS " & Cells(1, k).Value & " " & YearThree
ElseIf k > 81 And k < 95 Then
Cells(1, k).Value = "ERRORS " & Cells(1, k).Value & " " & YearOne
ElseIf k > 94 And k < 108 Then
Cells(1, k).Value = "ERRORS " & Cells(1, k).Value & " " & YearTwo
ElseIf k > 107 And k < 121 Then
Cells(1, k).Value = "ERRORS " & Cells(1, k).Value & " " & YearThree
End If
Next k
End Sub