If Conditions are met, It wil transfer to another worksheet.

Hello.

Please help me to seperate the following. All of these are the found in one worksheet.

On column K if found the word Received and Pending, the whole row will transfer to another sheet named Errors and Others.
On column Z and AA if found the word Error, the whole row will transfer to another sheet named Errors and Others.

Please help!

:) THanks in advance! :D

Hi

See 'Similar threads' at the bottom of this page. Post back if that doesn't help.

Hi there, I have a different situations compared to other that has a similar posts.

Please help me.


Thanks!

Hi

Untested. Adjust the ranges and sheet names.

Code:

---

Option Explicit

Sub kTest()
   
    Dim wksSource      As Worksheet
    Dim wksDest        As Worksheet
    Dim rngFound        As Range
    Dim LastRow        As Long
    Dim x, i            As Long
   
    Const SourceCol1 = 11  'col K
    Const SearchKey1 = "Received,Pending,aron" 'separated by comma
    Const SourceCol2 = 26  'col Z
    Const SourceCol3 = 27  'col AA
    Const SearchKey2 = "Error"
   
    Set wksSource = Worksheets("Sheet1")    'adjust source sheet name
    Set wksDest = Worksheets("Errors and Others")  'adjust destination sheet name
   
    Application.ScreenUpdating = 0
    With wksSource.Columns(SourceCol1)
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        With .Cells(1, 1).Resize(LastRow)
            x = Split(SearchKey1, ",")
            For i = 0 To UBound(x)
                .AutoFilter 1, x(i)
                On Error Resume Next
                Set rngFound = Nothing
                Set rngFound = .Cells(1).Offset(1).Resize(.Rows.Count - 1, 1).SpecialCells(12)
                On Error GoTo 0
                If Not rngFound Is Nothing Then
                    rngFound.EntireRow.Copy wksDest.Cells(SourceCol1 & wksDest.Rows.Count).End(xlUp).Offset(2)
                End If
                .AutoFilter
            Next
        End With
    End With
   
    With wksSource.Columns(SourceCol2)      'second source
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        With .Cells(1, 1).Resize(LastRow)
            x = Split(SearchKey2, ",")
            For i = 0 To UBound(x)
                .AutoFilter 1, x(i)
                On Error Resume Next
                Set rngFound = Nothing
                Set rngFound = .Cells(1).Offset(1).Resize(.Rows.Count - 1, 1).SpecialCells(12)
                On Error GoTo 0
                If Not rngFound Is Nothing Then
                    rngFound.EntireRow.Copy wksDest.Cells(SourceCol1 & wksDest.Rows.Count).End(xlUp).Offset(2)
                End If
                .AutoFilter
            Next
        End With
    End With
   
    With wksSource.Columns(SourceCol2)      'third source column
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        With .Cells(1, 1).Resize(LastRow)
            x = Split(SearchKey2, ",")
            For i = 0 To UBound(x)
                .AutoFilter 1, x(i)
                On Error Resume Next
                Set rngFound = Nothing
                Set rngFound = .Cells(1).Offset(1).Resize(.Rows.Count - 1, 1).SpecialCells(12)
                On Error GoTo 0
                If Not rngFound Is Nothing Then
                    rngFound.EntireRow.Copy wksDest.Cells(SourceCol1 & wksDest.Rows.Count).End(xlUp).Offset(2)
                End If
                .AutoFilter
            Next
        End With
    End With
    Application.ScreenUpdating = 1
   
End Sub

---

Hi,

There is nothing happens when I am running the codes. I have completed the necessary requirements to fully run it.

Please help.

Are you getting error messages? What do they say? Which line is highlighted?