cut and paste a certain row of data

Question

I have a data set and I needed certain cells cut and pasted to the subsequent rows below it. The code would ideally cut and paste to all rows below it and then stop once it reaches a blank row. After the blank row, it would begin cut and pasting the next row of data to its subsequent rows and repeat. My data looks like this.

Column A    Column B    Column C    Column D

123456789   QASD        School  
AWQTY192830 GHST        School      Car
AWQTY192830 GHST        School      Car
AWQTY192830 GHST        School      Car
AWQTY192830 GHST        School      Car

987654321   TWER        Work    
PWLRY437281 DFSW        Work        Bus
PWLRY437281 DFSW        Work        Bus

827361920   LOWP        Work    
QLAPT829183 POWE        Work        Bike

What I need, for example, is cell A3 (this is a 9-digit number) to be cut and pasted in cell E4:E7 and cell B3 cut and pasted into cell F4:F7. After it's done cut/pasting, it would stop at the blank row below and then start at the next row with data and repeat.

What i've written so far:

Sub cut_paste()

Dim nr As Integer
For nr = 1 To 195

If Len(Range("A" & nr)) = 9 Then

Range("A" & nr).Select
Selection.Cut
Range("N" & nr).Select
ActiveSheet.Paste
Range("B" & nr).Select
Selection.Cut

Range("O" & nr).Select
ActiveSheet.Paste

Next nr

End Sub

Any help is greatly appreciated. Thanks.

Possible duplicate of [VBA Cut and Paste error](https://stackoverflow.com/questions/13323915/vba-cut-and-paste-error) — Samuel Hulla, Jul 30 '18 at 12:05
Try to apply [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) to your code. — Pᴇʜ, Jul 30 '18 at 12:07
This is just a cut/paste line of code. I needed something that would loop through the worksheet and cut/paste specific cells to other cells, skip blanks, and resume at the next cell filled with data. — Jane Alice, Jul 30 '18 at 12:07
Can you add `Application.CutCopy = False` before the `Next nr` line? — Vityata, Jul 30 '18 at 12:17

Pᴇʜ · Accepted Answer · 2018-07-30T12:30:01.107

I suggest the following:

Option Explicit

Public Sub CopyData()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Tabelle11") 'specify workbook

    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row 'find last used row

    Dim CopyRow As Long 'remember row where to copy from

    Dim iRow As Long
    For iRow = 1 To LastRow
        If Len(ws.Cells(iRow, "A")) = 9 Then 'if number then remember copyrow
            CopyRow = iRow
        ElseIf Len(ws.Cells(iRow, "A")) > 0 And CopyRow > 0 Then 'if not a empty line then paste
            ws.Cells(iRow, "E").Value = ws.Cells(CopyRow, "A").Value
            ws.Cells(iRow, "F").Value = ws.Cells(CopyRow, "B").Value
        End If
    Next iRow
End Sub

Or the following if the rows that you copied from should be deleted:

Option Explicit

Public Sub CopyData()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Tabelle11") 'specify workbook

    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row 'find last used row

    Dim CopyRow As Long 'remember row where to copy from
    Dim RowsToDelete As Range

    Dim iRow As Long
    For iRow = 1 To LastRow
        If Len(ws.Cells(iRow, "A")) = 9 Then 'if number then remember copyrow
            CopyRow = iRow
            If RowsToDelete Is Nothing Then 'remember which rows we want to delete in the end.
                Set RowsToDelete = ws.Rows(CopyRow)
            Else
                Set RowsToDelete = Union(RowsToDelete, ws.Rows(CopyRow))
            End If
        ElseIf Len(ws.Cells(iRow, "A")) > 0 And CopyRow > 0 Then 'if not a empty line then paste
            ws.Cells(iRow, "E").Value = ws.Cells(CopyRow, "A").Value
            ws.Cells(iRow, "F").Value = ws.Cells(CopyRow, "B").Value
        End If
    Next iRow

    RowsToDelete.Delete
End Sub

I keep getting an "object defined error" at this line.... ws.Cells(iRow, "E").Value = ws.Cells(CopyRow, "A").Value — Jane Alice, Jul 30 '18 at 12:24
@JaneAlice Are there any header rows? If so adjust `For iRow = 1 To …` to your first data row. So if there is one header row use `For iRow = 2 To …` or just replace `ElseIf Len(ws.Cells(iRow, "A")) > 0 Then` with `ElseIf Len(ws.Cells(iRow, "A")) > 0 And CopyRow > 0 Then`. Fixed the code in the answer. — Pᴇʜ, Jul 30 '18 at 12:28
@JaneAlice Please be more specific about what you are trying to do? What "special values" do you mean? — Pᴇʜ, Jul 30 '18 at 12:50
when it copies over to the new cells, it chops off the leading zeros. — Jane Alice, Jul 30 '18 at 12:56
Well then you probably want to copy the `.Text` instead of the `.Value` or use a 9-digit number format in your destination column. — Pᴇʜ, Jul 30 '18 at 12:57

cut and paste a certain row of data

1 Answers1