Rows are deleting when I would like to keep.

[Sdwd76]

hi my rows are being moved (cut and pasted) I would like to just copy and paste.

Also if possible only paste certain cells from source

Thanks in advance

===================================================

Sub moveFALSE()

Application.ScreenUpdating = False

Dim rs1 As Worksheet, rs2 As Worksheet
Set rs1 = Sheets("Start")
Set rs2 = Sheets("Finish")

lr = rs1.Range("A" & Rows.count).End(xlUp).Row

For r = 1 To lr

If rs1.Cells(r, "CJ") = "Floor Level" Then
rs1.Cells(r, "A").EntireRow.Copy Destination:=rs2.Range("A" & Rows.count).End(xlUp).Offset(1)
rs1.Cells(r, "A") = True
End If

Next r

On Error Resume Next
rs1.Range("A1:A" & lr).SpecialCells(xlCellTypeConstants, 4).EntireRow.Delete
On Error GoTo 0

Application.ScreenUpdating = True

End Sub

 

[rollis13]

Get rid of these three lines of code and your source rows will not be deleted.

On Error Resume Next
rs1.Range("A1:A" & lr).SpecialCells(xlCellTypeConstants, 4).EntireRow.Delete
On Error GoTo 0

Here is where you're choosing to copy the entire row:
rs1.Cells(r, "A").EntireRow.Copy

 

[Sdwd76]

Rollis thank you.

How would I go about copying certain cells for example. Cells BM and BP to the finals sheet on the next available row in col C and E

 

[rollis13]

Add a counter for the new row in destination and change the macro like this:

Option Explicit
Sub moveFALSE()
    Application.ScreenUpdating = False
    Dim rs1 As Worksheet, rs2 As Worksheet
    Set rs1 = Sheets("Start")
    Set rs2 = Sheets("Finish")
    Dim lr, lr2, r                                '<=added
    lr = rs1.Range("A" & Rows.Count).End(xlUp).Row
    For r = 1 To lr
        If rs1.Cells(r, "CJ") = "Floor Level" Then
            lr2 = rs2.Range("C" & Rows.Count).End(xlUp).Row '<=added
            rs1.Cells(r, "BM").Copy Destination:=rs2.Range("C" & lr2).Offset(1) '<=changed
            rs1.Cells(r, "BP").Copy Destination:=rs2.Range("E" & lr2).Offset(1) '<=added
            rs1.Cells(r, "A") = True
        End If
    Next r
    Application.ScreenUpdating = True
End Sub

 

[Sdwd76]

Morning thanks this is working

only issue is if I have the word "Floor Level" in 4 rows it will only return data for the last row which has "floor Level". What i require is all 4 rows data which have the same word etc. if this is an easy fix please advise thanks in advance

 

[Sdwd76]

ignore this it is working now. Realised I changed it to start from A instead of C but there was nothing in A lol when the row was copying over Now i have added something in A and it does go to the next row. Brilliant thanks again!!!!

 

[Sdwd76]

Rollis one last question. Some of the cells have formulas so when it copies it displays REF
How can i set it so it only copies and values what is in the cell. So the info i need and not the formula?

I was thinking if easy that it searches all rows in the sheet where the data is and copies and pastes values which in turn the formula would word?

 

[rollis13]

Glad having been of some help.

 

[rollis13]

Some of the cells have formulas so when it copies it displays REF
How can i set it so it only copies and values what is in the cell. So the info i need and not the formula?

Change the two line of code that carry out the copy/paste, like this:

rs1.Cells(r, "BM").Copy
rs2.Range("C" & lr2).Offset(1).PasteSpecial Paste:=xlPasteValues '<=changed
rs1.Cells(r, "BP").Copy
rs2.Range("E" & lr2).Offset(1).PasteSpecial Paste:=xlPasteValues '<=changed