Cut-Paste copies only one row and not all the rows - excel

Question

I am trying 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.
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

Answer 1

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