Filter specific Text from column and copy to Target sheet

Hello,

I'm using below code to copy the data from "Raw Data" to "ProjectSummary" tab.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, ColArr, i As Long, ws As Worksheet
ColArr = Array("P", "Q", "U", "O", "N", "R")
Set ws = Sheets("Raw Data")
If Not Intersect(Target, Range("B1")) Is Nothing Then
    Application.EnableEvents = False
    x = Application.Match(Target, ws.Range("C:C"), 0)
    If Not IsError(x) Then
        Range("B2").Resize(5) = Application.WorksheetFunction.Transpose(Array(ws.Range("D" & x), ws.Range("H" & x), ws.Range("A" & x), ws.Range("X" & x), ws.Range("I" & x)))
        For i = LBound(ColArr) To UBound(ColArr)
            If Not IsError(ws.Range(ColArr(i) & x)) Then Range("E" & i + 1) = ws.Range(ColArr(i) & x)
        Next i
        Range("A8").CurrentRegion.Delete
        With ws
            With .Cells(1).CurrentRegion
                .AutoFilter 3, Target
                Union(.Columns("J"), .Columns("L"), .Columns("S"), .Columns("V"), .Columns("Z"), .Columns("AP"), .Columns("AQ:AR")).Copy Range("A8")
                .AutoFilter
            End With
        End With
    End If
    Application.EnableEvents = True
End If
End Sub

My further requirement is that, rather than copying all the rows to "ProjectSummary", I want macro to look for a text "Positive" in column AO (Raw Data tab) and only copy the "Positive" row data to "Project Summary" tab. Sample attached for reference.

Please suggest with changes in the above code.

Thanks !

Well ! i've made some changes to the code which I posted in my first thread

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, ColArr, i As Long, ws As Worksheet
ColArr = Array("P", "Q", "U", "O", "N", "R")
Set ws = Sheets("owssvr")
If Not Intersect(Target, Range("B1")) Is Nothing Then
    Application.EnableEvents = False
    x = Application.Match(Target, ws.Range("C:C"), 0)
    If Not IsError(x) Then
        Range("B2").Resize(5) = Application.WorksheetFunction.Transpose(Array(ws.Range("D" & x), ws.Range("H" & x), ws.Range("A" & x), ws.Range("X" & x), ws.Range("I" & x)))
        For i = LBound(ColArr) To UBound(ColArr)
            If Not IsError(ws.Range(ColArr(i) & x)) Then Range("E" & i + 1) = ws.Range(ColArr(i) & x)
        Next i
        Range("A8").CurrentRegion.Delete
        With ws
            With .Cells(1).CurrentRegion
            ws.ListObjects("Table_owssvr").Range.AutoFilter Field:=3, Criteria1:=Target
                '.AutoFilter 3, Target
                Union(.Columns("J"), .Columns("L"), .Columns("S"), .Columns("V"), .Columns("Z"), .Columns("AP"), .Columns("AQ:AR")).Copy Range("A8")
                ws.ListObjects("Table_owssvr").Range.AutoFilter
            End With
        End With
    End If
    Application.EnableEvents = True
End If
End Sub

where can i apply the filter to copy "positive" rows ?

Thanks !

Well ! I added one more filter as :

ws.ListObjects("Table_owssvr").Range.AutoFilter Field:=41, Criteria1:="Positive"

This allowed to copy and paste the Positive row to the target sheet.

But if there is only "Negative" rows in the "owssvr" tab, I should get a msg box as "No Data found"

Thanks !

Hi Sintek,

I made some changes to the code provided by you and was able to fix the issue.

Thanks ! for your support as always.

Cheers.