Home » excel » excel – cut and paste a certain row of data

excel – cut and paste a certain row of data

Posted by: admin May 14, 2020 Leave a comment

Questions:

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.

How to&Answers:

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