Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
714 views
in Technique[技术] by (71.8m points)

excel - VBA cut-paste range of data

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

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

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.


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...