根据单元格值将行复制到工作表底部并按升序排序

Question

I have an Excel sheet which is pulled from JIRA. This sheet has variable rows each week. Once it is pulled, I have a macro which performs various actions. One of these is to move certain rows to bottom of the sheet based on a value present in Column 'F'. In this particular case, if the value 'RCR' is present in column 'F', then that particular row should cut and paste at the bottom.

For this I have written the below code. This code works well and does the job. But the issue is since it loops from bottom to top, the list of rows with 'RCR' values is in a descending manner. But I want the rows to be sorted in an ascending manner.

If I use "1 to lastRowOne" in the For loop, then what happens is the row gets deleted after the move has been done, due to this, if the next row also has the value of 'RCR', that particular row is skipped because it takes the place of the deleted row. So the macro moves to the row after that, which is causing the macro to miss certains rows having consecutive value = 'RCR'.

Dim wsOne As Worksheet
Dim lastRowOne As Long
Dim lastRowTwo As Long

Set wsOne = ActiveWorkbook.Sheets("Status")

lastRowOne = wsOne.Cells(wsOne.Rows.Count, 1).End(xlUp).Row
lastRowTwo = wsOne.Cells(wsOne.Rows.Count, 1).End(xlUp).Row + 1

For I = lastRowOne To 1 Step -1
    If wsOne.Range("F" & I).Value = "RCR" Then
        wsOne.Rows(lastRowTwo).Value = wsOne.Rows(I).Value
        wsOne.Rows(I).EntireRow.Delete
    End If
Next

Is there a way that this can be remedied?

Answer 1

Use Union() to make a non-contiguous range, copy that range and then delete afterwards.

    Dim wsOne As Worksheet
    Dim lastRowOne As Long
    Dim i As Long
    Dim rng As Range
    
    Set wsOne = ActiveWorkbook.Sheets("Status")
    
    lastRowOne = wsOne.Cells(wsOne.Rows.Count, 1).End(xlUp).Row
    With wsOne
        For i = 1 To lastRowOne
            If wsOne.Range("F" & i).Value = "RCR" Then
                If rng Is Nothing Then
                    Set rng = .Rows(i)
                Else
                    Set rng = Union(rng, .Rows(i))
                End If
            End If
        Next
        rng.Copy .Range("A" & lastRowOne + 1)
        rng.Delete
    End With