Excel macro to move a row to bottom - excel

Question

Good day,
I am trying to create a macro that moves a row to the bottom of the sheet based on criteria.
What i have been able to do so far is copy the row to the bottom, but this will create a duplicate row for me, where in reality i only need it to be moved.
'Moving column "Grand Total" to bottom
With Wbk4.Sheets("TEST")
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
'Loop through each row
For x = 2 To FinalRow
'Decide if to copy based on column A
ThisValue = Cells(x, 1).Value
If ThisValue = "Grand Total" Then
Cells(x, 1).Resize(1, 33).Copy
lrow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A" & lrow + 1, "Z" & lrow + 1).PasteSpecial xlPasteAll
End If
Next x
End With
Thanks

Answer 1

As you've provided no sample data, it is hard to recommend a custom sort but a temporary helper column off the right side could quickly move all Grand Total rows to the bottom.
With Wbk4.Sheets("TEST")
With .Cells(1, 1).CurrentRegion
.Columns(.Columns.Count).Offset(1, 1).Resize(.Rows.Count - 1, 1).Formula = "=--(A2=""Grand Total"")"
End With
With .Cells(1, 1).CurrentRegion 'reestablish current region with new helper column
.Cells.Sort Key1:=.Columns(.Columns.Count), Order1:=xlAscending, _
Orientation:=xlTopToBottom, Header:=xlYes
.Columns(.Columns.Count).Cells.ClearContents
End With
End With
There are two additional sort keys (maximum of three without doubling up) if you wanted to add additional sorting order(s).

Answer 2

Try Cells(x, 1).EntireRow.Delete or Cells(x, 1).Resize(1, 33).Delete before End If

Answer 3

Thanks Jeeped, it works fine !!
I Did it using another method before trying your code, and it works too!!
I am posting it below for reference in case anyone is looking for code references in the future
'Moving column B to bottom
With Wbk4.Sheets("test")
FinalRow = .Cells(rows.Count, 1).End(xlUp).Row
'Loop through each row
For x = 2 To FinalRow
'Decide if to copy based on column A
ThisValue = .Cells(x, 1).Value
If ThisValue = "Grand Total" Then
.Cells(x, 1).Resize(1, 33).Select
Selection.Cut
lRow = .Range("A" & .rows.Count).End(xlUp).Row
.Range("A" & lRow + 1, "Z" & lRow + 1).Select
ActiveSheet.Paste
End If
Next x
End With
'Delete Blank Rows
Dim i As Long
With Wbk4.Sheets("test")
For i = .Range("A" & rows.Count).End(xlUp).Row To 1 Step -1
If .Range("A" & i) = "" Then
.Range("A" & i).EntireRow.Delete
End If
Next i
End With