Help with some Excel VB coding

[jjsaw5]

Hello,

I have gotten some help with developing code that will do the following for me.

I have a workbook with 5 seperate tabs on of which is a "Completed" tab.
The other tabs contain current jobs and projects that are being worked on. My code goes through each record in each sheet and if the status of the record has been changed to completed, it moves copies and pastes the record into the "Completed" tab.

What my problem is, the record that was copied and pasted into the "Completed" tab still remains in its original tab. I need somethign that is going to remove the record for me after it is copied.

Here is my code.....

Sub CompActions()

Dim lLastRow As Long, lRow As Long, lCompRow As Long
Dim wsShts As Worksheet, wsComplete As Worksheet

Set wsComplete = Sheets("Completed")
lCompRow = wsComplete.Cells(Rows.Count, 6).End(xlUp).Row + 1

For Each wsShts In ThisWorkbook.Worksheets
    
    If wsShts.Name <> "Completed" Then
        lLastRow = wsShts.Cells(Rows.Count, 6).End(xlUp).Row
        For lRow = 2 To lLastRow
            If Left(UCase(wsShts.Cells(lRow, 6).Value), 4) = "COMP" Then
                wsShts.Range("A" & lRow).EntireRow.Copy
                wsComplete.Range("A" & lCompRow).PasteSpecial
                lCompRow = lCompRow + 1
            End If
        Next lRow
   End If

Next wsShts
    
End Sub

Any help is greatly apprichiated!!

 

[Jonmo1]

Try this out. Definately Make a backup copy of your file first.

Sub CompActions() 

Dim lLastRow As Long, lRow As Long, lCompRow As Long 
Dim wsShts As Worksheet, wsComplete As Worksheet 

Set wsComplete = Sheets("Completed") 
lCompRow = wsComplete.Cells(Rows.Count, 6).End(xlUp).Row + 1 

For Each wsShts In ThisWorkbook.Worksheets 
    
    If wsShts.Name <> "Completed" Then 
        lLastRow = wsShts.Cells(Rows.Count, 6).End(xlUp).Row 
        For lRow = lLastRow to 2 Step -1
            If Left(UCase(wsShts.Cells(lRow, 6).Value), 4) = "COMP" Then 
                wsShts.Range("A" & lRow).EntireRow.Copy 
                wsComplete.Range("A" & lCompRow).PasteSpecial 
                wsShts.Rows(lRow).EntireRow.Delete
                lCompRow = lCompRow + 1 
            End If 
        Next lRow 
   End If 

Next wsShts 
    
End Sub