Copy data from another workbook based on criteria

[p9j123]

I have the following macro that will copy data from wbSrc to wbDest.

I need help in modifying this to ensure that
1. this will only copy data if the column F is equal to "Valid"
2. This will not copy duplicate (based on column B which is the job number)

Sub copyfeedback()
Dim WbSrc As Workbook
Dim wbDest As Workbook
' set report workbook to workbook object (works only is the file is already
'open)
Set wbDest = ThisWorkbook
Application.ScreenUpdating = False
' open the source workbook and select the source sheet
Set WbSrc = Workbooks.Open(filename:="C:\Users\Tutorial\Desktop\Work\Feedback Tracker.xlsx")
' copy the source range and paste in 1 line , paste at "C3:E9"
WbSrc.Sheets("Sheet1").Range("A3:I9").Copy
wbDest.Sheets("Feedback").Range("A3:I9").PasteSpecial xlPasteValues
WbSrc.Close False
'wbDest.Save
Application.ScreenUpdating = True
End Sub

 

[My Aswer Is This]

I answered a similar question of yours lately.
Titled Copy cells from another open Workbook.
But you never responded back if that worked for you.
It's customary to respond back.

 

[p9j123]

Hi,

Quite tied up right now, haven't tested it yet.

That is also a different concern, it only copies from certain column, the challenge i am having with the current project I am working with right now requires a criteria and a validation of duplicate entry

 

[p9j123]

This has been resolved, for others who might have the same requirements/needs please see below code.

Sub ExtractFeedback()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
    
Set Roster1 = Workbooks.Open("C:\Users\Tutorial\Desktop\Work\Feedback Tracker.xlsx", ReadOnly:=True)
Set ws1 = Roster1.Worksheets("Sheet1")
Set Roster = ThisWorkbook
Set ws = Roster.Sheets("Feedback")
  
lr = ws1.Cells(rows.Count, "A").End(xlUp).Row
For l = 1 To lr
     irow = ws.Cells(rows.Count, "A").End(xlUp).Row + 1
    If ws1.Cells(l, 6) = "Valid" Then
           
            ws.Cells(irow, 1).Value = ws1.Cells(l, 1).Value
            ws.Cells(irow, 2).Value = ws1.Cells(l, 2).Value
            ws.Cells(irow, 3).Value = ws1.Cells(l, 3).Value
            ws.Cells(irow, 4).Value = ws1.Cells(l, 4).Value
            ws.Cells(irow, 5).Value = ws1.Cells(l, 5).Value
            ws.Cells(irow, 6).Value = ws1.Cells(l, 6).Value
    End If
Next l
         Roster1.Close savechanges:=False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic


End Sub