Sub Filter_Me_Please()
'Modified 10/24/2021 7:57:22 PM EDT
Application.ScreenUpdating = False
Dim lastrow As Long
Dim C As Long
Dim s As Variant
Dim i As Long
C = 3 ' Column Number Modify this to your need
s = "Yes" 'Search Value Modify to your need
lastrow = Cells(Rows.Count, C).End(xlUp).Row
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Archive"
For i = 1 To Sheets.Count - 1
With Sheets(i).Cells(1, C).Resize(lastrow)
.AutoFilter 1, s
counter = .Columns(C).SpecialCells(xlCellTypeVisible).Count
If counter > 1 Then
lastrowa = Sheets("Archive").Cells(Rows.Count, 1).End(xlUp).Row + 1
.Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Offset(, -2).Copy Sheets("Archive").Cells(lastrowa, 1)
Else
MsgBox "No values found"
End If
.AutoFilter
End With
Next
Application.ScreenUpdating = True
End Sub