Help with some Excel VB coding

jjsaw5

New Member
Joined
Jun 19, 2007
Messages
4
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.....

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!!
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"

Jonmo1

MrExcel MVP
Joined
Oct 12, 2006
Messages
44,061
Try this out. Definately Make a backup copy of your file first.

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 = 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
 

Watch MrExcel Video

Forum statistics

Threads
1,130,310
Messages
5,641,450
Members
417,210
Latest member
rins

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top