How to copy cell value from one table to another table with Criteria

Sub Test()

Application.ScreenUpdating = False

        Sheet2.ListObjects("Table2").Unlist '---->Use your actual table name.

        With Sheet1.ListObjects("Table1").DataBodyRange  '---->Use your actual table name.
                .AutoFilter 4, "Yes"
                .Offset(1).Resize(.Rows.Count, .Columns.Count).Rows.Copy Sheet2.Range("A" & Rows.Count).End(3)(2)
                .AutoFilter
        End With
        
        Sheet2.Select
        Sheet2.ListObjects.Add(xlSrcRange, Cells(1, 1).CurrentRegion, , xlYes).Name = "Table2" '---->Use your actual table name.
        Sheet1.Select
        
Application.ScreenUpdating = True

End Sub