VBA 剪切粘贴范围的数据

Question

I'm attempting to make a large amount of Genetic data, a little more legible in Excel using VBA. I am trying to cut and paste every 7 cells that have data, after the 15th column, and drop them down under columns 8-15. The example of what I need is in the picture included. DATA EXAMPLE (RAW vs What i need it to look like) As you can see by the code, the real data is a little bigger. (At 680 rows and over 100 columns.)

When I try running the code, it is failing when it goes to paste the range of data into the new line. (error 1004)

The code I have is:

Sub ShiftRows()

    Dim codingCol, startCol As Integer

    Dim LastRow As Integer
    Dim CurrentRow As Integer
    Dim LastCol, BeginCol As Integer
    Dim CurrentInsertRow As Integer


    LastRow = 2

    For CurrentRow = 680 To LastRow Step -1
        LastCol = 15
        Do While Cells(CurrentRow, LastCol) <> ""
        LastCol = LastCol + 1
        Loop

    CurrentInsertRow = CurrentRow

    For BeginCol = 0 To ((LastCol - 15) / 7) - 1

        CurrentInsertRow = CurrentInsertRow + 1
        Rows(CurrentRow).Offset(1).Insert shift:=xlShiftDown
        Range(Cells(CurrentRow, 15 + (BeginCol * 7)).Address & ":" & Cells(CurrentRow, 15 + (BeginCol * 7) + 6).Address).Cut
        Range("H:N" & CurrentInsertRow).Paste

        Next BeginCol
    Next CurrentRow
End Sub

Answer 1

Range.Cut allows you to specify the paste range after it. Try something like:

Range("A1:A3").Cut Range("B10")

Where you substitute my range values for the ones you want.

Answer 2

Your cell referrence is "H:N" & CurrentInsertRow , or H:N2 for example, this is incomplete. Try:

Range("H" & CurrentInsertRow & ":N" & CurrentInsertRow).Paste