VBA to move rows to end of sheet based on cell contents

[lday75]

Hello All,

I have a block of code that basically searches for the word Constellation in col G and if found moves the entire row to the end of the sheet. HOWEVER the way I am going about this seems to be long and not very efficient. Pasted below is my code, could someone out there possibly give some advice on how to do this in a more efficient manner?

Sub FltrConst()

Sheets.Add.Name = "Const"
Sheets("HH_Samples").Activate

Dim LR As Long

Range("G1").AutoFilter
Range("G1").AutoFilter Field:=7, Criteria1:="=*Constellation*"
LR = Range("A" & Rows.Count).End(xlUp).Row


If LR > 1 Then Range("A2:T" & LR).Copy Sheets("Const").Range("A1")

Rows("2:" & LR).Delete Shift:=xlUp
Range("G1").AutoFilter

ThisWorkbook.Save

Sheets("HH_Samples").Activate
LastRow = Cells(Rows.Count, "I").End(xlUp).Row
Sheets("Const").Activate
LR = Range("A" & Rows.Count).End(xlUp).Row
If LR > 1 Then Range("A1:T" & LR).Copy Sheets("HH_Samples").Range("A" & LastRow + 1)

Application.DisplayAlerts = False
Sheets("Const").Delete
Application.DisplayAlerts = True

Range("A1").Select

End Sub

Thank You

[arlu1201]

This is a duplicate post and as such does not comply with Rule 5 of our forum rules. This thread will now be closed, you may continue in your other thread.

Thread Closed.