How to copy a row based on a specific condition from one sheet to another worksheet using vba

Viewed 36

I am trying to copy a row based on a specific condition from sheet A to sheet B. Also, every time the row is copied to sheet B, the previously copied row from sheet B should move down and the new row should be copied at the very top.

Currently I have the following code (from SidianDMW's post here) but it is copying the row below the previous row

Sub MoveBasedOnValue2()
Dim xRg As Range
Dim Cell As Range
Dim A As Long
Dim B As Long
Dim C As Long
A = Worksheets("CAI").UsedRange.Rows.Count
B = Worksheets("AR").UsedRange.Rows.Count
If B = B + 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("CAI").UsedRange) = 0 Then B = 0
End If
Set xRg = Worksheets("CAI").Range("G4:G" & A)
On Error Resume Next
Application.ScreenUpdating = False
For C = 1 To xRg.Count
    If CStr(xRg(C).Value) = "In Progress" Then
    xRg(C).EntireRow.Copy Destination:=Worksheets("AR").Range("A" & B + 1)
    xRg(C).EntireRow.Delete
If CStr(xRg(C).Value) = "In Progress" Then
    C = C - 1
End If
B = B + 1
End If
Next
Application.ScreenUpdating = True
End Sub
1 Answers

It's hard to see what's going on without a screenshot or something, but perhaps you can leverage this code. Assuming you always mean "the top" or Row 1, this will always insert a new row as the destination point and paste in.

If it's somewhere else in the worksheet, you'd just need to identify the point of entry for the insert.

For C = 1 To xRg.Count
    If CStr(xRg(C).Value) = "In Progress" Then
        Worksheets("AR").Rows(1).Insert shift:=xlDown
        xRg(C).EntireRow.Copy Destination:=Worksheets("AR").Range("A1")
        xRg(C).EntireRow.Delete
        If CStr(xRg(C).Value) = "In Progress" Then
            C = C - 1
        End If
        B = B + 1
    End If
Next
Related