VBA Cut-Paste копирует только одну строку, а не все строки

Question

Я пытаюсь код здесь соответствовать всем ячейкам столбца "M" в Sheet1 и Sheet3, а также скопировать и удалить все строки из Sheet1, которые содержат любое значение из столбца Sheet3 "M".Кроме того, я хочу, чтобы записи были скопированы в «Sheet2» (все записи должны быть удалены). Однако он удаляет все записи, но копирует только первую строку, а не все необходимые строки.Я попробовал некоторые решения, которые нашел в Интернете, но безуспешно.Может ли кто-нибудь предложить, в чем может быть проблема.

Ниже приведен код:

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

Ну, вот ваш почти такой же код, только что добавленные With блоки и ., потому что это могло быть проблемой

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