Dfyjkt

I am trying a code here to match all the cells of the "M" column in Sheet1 and Sheet3, and copy and delete all the rows from Sheet1 that contain any value from Sheet3's "M" column. Also, I want the records to get copied into "Sheet2" (all records to be deleted) However, it is deleting all the records but copying only the first row and not all the required rows. I tried some solutions I found online, but with no luck. Could anyone please suggest what might be the problem.

Below is the code:

Sub DeleteRows()

Dim rng As Range
Dim r As Long
Dim lr1 As Long
Dim lr3 As Long
Dim str As Variant
Dim i As Long: i = 1

Application.ScreenUpdating = False


lr3 = Sheets("Sheet3").Cells(Rows.Count, "M").End(xlUp).Row

Set rng = Sheets("Sheet3").Range("M2:M" & lr3)


lr1 = Sheets("Sheet1").Cells(Rows.Count, "M").End(xlUp).Row

For r = lr1 To 2 Step -1

 str = Sheets("Sheet1").Cells(r, "M")

 If Application.WorksheetFunction.CountIf(rng, str) > 0 Then

 Sheets("Sheet1").Range(Cells(r, "A"), Cells(r, "N")).Cut Sheets("Sheet2").Cells(i, "A")
 Sheets("Sheet1").Range(Cells(r, "A"), Cells(r, "N")).Delete (xlShiftUp)
 i = i + 1
 End If
Next r

Application.ScreenUpdating = True

End Sub

Appreciate your help! Thanks in advance!

Well here's your almost exact same code just added With blocks and .'s because that might've been the problem

Sub DeleteRows()

 Dim rng As Range
 Dim r As Long
 Dim lr1 As Long
 Dim lr3 As Long
 Dim str As Variant
 Dim i As Long: i = 1

 Application.ScreenUpdating = False
 With ThisWorkbook.Worksheets("Sheet3")
 lr3 = .Cells(.Rows.Count, "M").End(xlUp).Row
 Set rng = .Range("M2:M" & lr3)
 End With

 With ThisWorkbook.Worksheets("Sheet1")
 lr1 = .Cells(.Rows.Count, "M").End(xlUp).Row
 For r = lr1 To 2 Step -1
 str = .Cells(r, "M").Value
 If Application.WorksheetFunction.CountIf(rng, str) > 0 Then
 Sheets("Sheet2").Range(Sheets("Sheet2").Cells(i, "A"), Sheets("Sheet2").Cells(i, "N")).Value = _ 
 .Range(.Cells(r, "A"), .Cells(r, "N")).Value
 .Range(.Cells(r, "A"), .Cells(r, "N")).Delete (xlShiftUp)
 i = i + 1
 End If
 Next r
 End With

 Application.ScreenUpdating = True
End Sub