move row based on cell value if row does not contain other value macro/vba

[dasumianco]

Is it possible to move rows that contain a number of specific values but leave rows that contain another value to another worksheet and then automatically delete the original row on the original worksheet?

I have around 250 values that are to be stripped from the original work sheet and moved onto another worksheet UNLESS another value is present in that row.

For example

If column L or N contains the variable values "TEST1" "TEST2".. and so on until "TEST250" then it is to be moved to worksheet 2 UNLESS column M contains the Value "current"?

any help with this would be greatly appreciated..

 

[kevin9999]

Could you please provide samples of your source & destination sheets using the XL2BB add in, or alternatively share your file via Dropbox, Google Drive or similar file sharing platform?

 

[kevin9999]

The following code assumes your data in sheet 1 starts in row 2 with row 1 being headers; that your data starts in column A and is contiguous; and that you want the rows meeting the criteria to be copied to the first available empty row in sheet 2. Please try on a copy of your workbook, and change the sheet names as appropriate.

Option Explicit
Sub dasumianco()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")          '<~~ *** Change to actual sheet names ***
    Set ws2 = Worksheets("Sheet2")
    Dim LRow As Long, LCol As Long, i As Long, a, b
    LRow = ws1.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    LCol = ws1.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column + 1

    a = ws1.Range("L2:N" & LRow)
    ReDim b(1 To UBound(a, 1), 1 To 1)
    For i = 1 To UBound(a, 1)
        If (a(i, 1) Like "TEST*" Or a(i, 3) Like "TEST*") And a(i, 2) <> "current" Then b(i, 1) = 1
    Next i
    ws1.Cells(2, LCol).Resize(UBound(b, 1)).Value = b

    i = WorksheetFunction.Sum(ws1.Columns(LCol))
    If i > 0 Then
        ws1.Range(ws1.Cells(2, 1), ws1.Cells(LRow, LCol)).Sort Key1:=ws1.Cells(2, LCol), _
        order1:=xlAscending, Header:=xlNo
        ws1.Range(ws1.Cells(2, 1), ws1.Cells(i + 1, LCol - 1)).Copy ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
        ws1.Cells(2, LCol).Resize(i).EntireRow.Delete
    End If
End Sub