Deleting rows based on criteria - vba

Question

I have a little code so I can move specific rows to a specific sheet which is structured as follows:
sheet 1 (contains all data)
sheet 2 (the destination sheet of rows to move)
So basically the code looks for a keyword on a specific column, and copies all rows that meet that criteria on the specified column from sheet 1 to sheet 2, it does that like a charm. The problem I have is because of data organization, I need to delete the rows once they have been copied, I tried using the .cut target instead of .copy target, and it works too, but it takes extremely long (about 1+ min), and it looks like that whole time is frozen as it doesn't let you select anything.
Any suggestions to accomplish this more efficiently? I am learning VBA, so please bear with me.
Sub Copydatatoothersheet()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Sheet1")
Set Target = ActiveWorkbook.Worksheets("Sheet2")
j = 3 ' Start copying to row 3 in target sheet
Application.ScreenUpdating = False
For Each c In Source.Range("BB:BB")
If c = "UNPAID" Then
'THIS IS THE LINE WHERE I REPLACE COPY WITH CUT
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c
Application.ScreenUpdating = True
End Sub

Answer 1

Try store the desired ranges in a variable then delete the entire rows of that stored range
Sub Copydatatoothersheet()
Dim c As Range
Dim j As Integer
Dim source As Worksheet
Dim target As Worksheet
Dim oRange As Range
' Change worksheet designations as needed
Set source = ActiveWorkbook.Worksheets("Sheet1")
Set target = ActiveWorkbook.Worksheets("Sheet2")
j = 3 ' Start copying to row 3 in target sheet
Application.ScreenUpdating = False
For Each c In source.Range("BB:BB")
If c = "UNPAID" Then
'THIS IS THE LINE WHERE I REPLACE COPY WITH CUT
source.Rows(c.Row).Copy target.Rows(j)
If oRange Is Nothing Then Set oRange = c Else Set oRange =
Union(oRange, c)
j = j + 1
End If
Next c
If Not oRange Is Nothing Then oRange.EntireRow.Delete
Application.ScreenUpdating = True
End Sub

Answer 2

Use AutoFilter
Sub foo()
Dim Source As Worksheet
Dim Target As Worksheet
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Sheet1")
Set Target = ActiveWorkbook.Worksheets("Sheet2")
With Source
With .Range("BB:BB" & .Cells(.Rows.Count, "BB").End(xlUp).Row) 'reference its column BB cells from row 1 (header) down to last not empty one
.AutoFilter field:=1, Criteria1:= "UNPAID"' filter referenced cells on 1st column with "UNPAID" content
If Application.WorksheetFunction.Subtotal(103, .Columns(1)) > 1 Then
With .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
Intersect(.EntireRow, .Parent.UsedRange), .Parent.UsedRange).Copy Destination:=Target.Range("A1") ' if any filtered cell other than the header then copy their entire rows and paste to 'Target' sheet starting from its cell A1
.EntireRow.Delete ‘finally, delete these rows
End With
End If
End With
.AutoFilterMode = False
End With
End Sub
You may also add the ScreenUpdating toggling