CODEWITHSUNDEEP
excelvba
Siddharth
Siddharth

Reputation: 53

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

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

Upvotes: 0

Views: 286

Answers (1)

Kubie
Kubie

Reputation: 1571

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

Upvotes: 1

Related Questions