My macro copy/paste but I want it to cut/paste

[atenney]

I am working with a macro that matches the cells in column A in sheet 1 with the cells in Column A in sheet 2 and if those cells match then copy/paste the following cells on the same row.
However now I need to cut and paste instead of copy and paste. But am still very new to VBA so can't change the code.
Here is the macro:

Public Sub cmdSearch_Click()
Dim r1 As Range, r2 As Range
Dim r3 As Range, r4 As Range
Dim cell As Range
Dim sRow As Long, res As Variant

sRow = 2
With Worksheets("Sheet2")
Set r2 = .Range(.Cells(sRow, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
With Worksheets("Sheet1")
Set r1 = .Range(.Cells(sRow, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
For Each cell In r2
If Application.CountIf(r1, cell) > 0 Then
res = Application.Match(cell, r1, 0)
If Not IsError(res) Then
Set r3 = r1(res)
With r1.Parent
Set r4 = .Range(r3(1, 2), .Cells(r3.Row, .Columns.Count))
End With
r4.Copy
cell.Offset(0, 1).PasteSpecial xlValues
End If
End If
Next
End Sub


Any help?

 

[btadams]

try this:

Public Sub cmdSearch_Click()
Dim r1 As Range, r2 As Range
Dim r3 As Range, r4 As Range
Dim cell As Range
Dim sRow As Long, res As Variant

sRow = 2
With Worksheets("Sheet2")
    Set r2 = .Range(.Cells(sRow, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
With Worksheets("Sheet1")
    Set r1 = .Range(.Cells(sRow, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
For Each cell In r2
    If Application.CountIf(r1, cell) > 0 Then
        res = Application.Match(cell, r1, 0)
        If Not IsError(res) Then
            Set r3 = r1(res)
            With r1.Parent
                Set r4 = .Range(r3(1, 2), .Cells(r3.Row, .Columns.Count))
            End With
            r4.Copy
            cell.Offset(0, 1).PasteSpecial xlValues
            r4.Clear
        End If
    End If
Next
End Sub

 

[atenney]

Thanks this macro worked!