Hi guys,

In desperate need of some help from you kind strangers.

I need a helping editing my code that MOVES (not copies) a row of data from one work sheet to another depending on what a cell in the STATUS column says.

E.G: Cell in (Column7"Status") = Remove -> I want the row of data to then move to "Delete" sheet.
E.G 2: Cell in (Column7"Status") of Improvement WIP sheet says "Complete" = Move to Workstack -> I want the row of data to then move to "Improvement Workstack" sheet.

I would like to apply this code to each seperate sheet, so then once a job is completed in WIP i can select status as "Complete" and move it to delete, OR if it is to be put on HOLD I can select "Move to Workstack" to move the row to the appropriate sheet.

My workbook:

Sheet 1: Improvement WIP
Sheet 2: Improvement Workstack
Sheet 3: Inbound WIP
Sheet 4: Inbound Workstack
Sheet 5: Delete

Column Names in every sheet:
Col1: Work Item
Col2: Service
Col3: Related Priority
Col4: Owner
Col5: Role
Col6: Objective
Col7: Status
Col8: Target Date

1) I currently have the following code which allows me to perform the action for COMPLETE, however I want the code to also apply the same rule for a status that says "Delete" (Move any row with the status "Remove" to the "Delete" sheet).

2) Currently the code only copies the data but instead I would like it to cut the data.
Current Code:


Sub SearchForString()

   Dim LSearchRow As Integer
   Dim LCopyToRow As Integer
   
   On Error GoTo Err_Execute
   
   'Start search in row 2
   LSearchRow = 26
   
   While Len(Range("A" & CStr(LSearchRow)).Value) > 0
   
      'If value in column E = "Mail Box", copy entire row to Sheet2
      If Range("G" & CStr(LSearchRow)).Value = "Complete" Then
      
         'Select row in Sheet1 to copy
         Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
         Selection.Copy
         
         'Paste row into Sheet2 in next row
         Sheets("Delete").Select
    Range("A26").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
         
         'Move counter to next row
         LCopyToRow = LCopyToRow + 1
         
         'Go back to Sheet1 to continue searching
         Sheets("Service Improvement WIP").Select
         
      End If
      
      LSearchRow = LSearchRow + 1
      
   Wend
   
   'Position on cell A3
   Application.CutCopyMode = False
   Range("A3").Select
   
   MsgBox "All matching data has been copied."
   
   Exit Sub
   
Err_Execute:
   MsgBox "An error occurred."
   
End Sub