Copy / paste specfic DATE to other worksheet.

Thanks for your reply...your code works.
However, there is a new situation here. I now got more years that i need to do the filter and i want seperate sheet for each year.
So, instead of manually type in the data, i have used VBA to find the year range, put into one column and delete all duplicate ones. The task is similar, but since excel could give more than 20 years, it would be tendious to do all the filtering maunally. AND, now i need excel to seperate the rows that contain the specific year range in any one the three cells and put them into a new sheet.

e.g.
The years that excel could find in the three columns(F:H) are ( 2001,2003,2006,2010, 2012,2020.....2033).. and they are pasted in column "S" in sheet 1. How could i tell excel create new sheets for the years ( sheets 2001, sheets 2003, sheet2006....),search through column (F:H) in sheet 1 to see if ANY of those columns contain that year, and paste them into the new sheet. To be more specific, in the newly created "Sheet 2001", the entire row where column(F:H) contains "2001" should be pasted. and in the newly created "Sheet 2033", the entire row where column(F:H) contains "2033" should be pasted..

Enclosed please find the reference.
https://authentification.site/files/23851477/Book32.xls
I have got sheet "2002" and "2003" here as results but for the real one i will need more years' sheets (as many as how many excel could extract in the previous stage; as shown in column L ) ......
I think this task should be quite usual (extracting by date), but i couldnt google the result....Pleas help!!

"in any one the three COLUMNS

Use a loop

Loop thru each year and apply formula. Filter the result and copy the visible rows to the sheet

Thanks for your help. however, i am totally new to "looping" so i could hardly figure out a way that perform: loop through the column,open new worksheet as well as sort out the correct year in the new sheet AT THE SAME TIME....
So far i could only figure out how to give sheet names to the newly created worksheet:( not even sure if it is looping)

Dim i As Long, LR As Long, sName As String

i = 2
5
If Cells(i, 19) = "" Then GoTo 10 ' I'm trying to count the no. of year
i = i + 1: GoTo 5
10
N = i - 1

For i = 2 To N

sName = Sheet4.Cells(i, 19).Value

Worksheets.Add(after:=Worksheets(Worksheets.count)).Name = sName
Next

I tried to code you suggest and filtered,
Range("K2").Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(AND(RC[8]<>"""",OR(YEAR(RC[-5])=R2C19,YEAR(RC[-5])=R2C19,YEAR(RC[-3])=R2C19))),1,0)"

It works... but i simply couldn't find a way to put the pieces together...can you give me any hints? This task is driving me insane!

Thanks again!

Here is a link
https://ccm.net/forum/affich-258700-interesting-question-for-excel-champions

That code first creates a list of unique value to see what we have to loop thru, you dont have that case as you already know

Then it loops for each value, apply filter and create sheet and copy the data. For you the change would be that as it loops thru each value, you have to apply formula first, then apply filter and when it comes to creating sheet, it uses the value that was used to filter, you either have to change formula to use year, instead of 1 as flag or when you create sheet, use the year

see if it makes any sense to you

I just tried to code...and changed a bit to match my criteria:

Sub details()

Dim i As Long

i = 2
5
If Cells(i, 1) = "" Then GoTo 10
i = i + 1: GoTo 5
10
N = i - 1

Sheets("Sheet4").Select
Range("H2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 3).Activate
ActiveCell.FormulaR1C1 = "C"

'apply the formula

Range("K2").Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(AND(R2C19<>"""",OR(YEAR(RC[-5])=R2C19,YEAR(RC[-5])=R2C19,YEAR(RC[-3])=R2C19))),1,0)"

Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Selection.Interior.ColorIndex = xlNone

' in here, i use sorting instead of AUTOfilter. or else, the crieria for year "column S" would go missing.

Columns("A:K").Select
Selection.Sort Key1:=Range("K2"), Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlStroke, DataOption1:=xlSortNormal

'because i used sorting, so i try to remove the range which contain "1" in column S

For i = 2 To N

If Cells(i, 11) <> 1 Then

ActiveSheet.Range(Cells(i, 1), Cells(i, 11)).Select

Selection.Delete Shift:=xlUp

End If

Next i


lMaxSupp = Cells(50, 19).End(xlUp).Row

For suppno = 2 To lMaxSupp
supName = Sheets("sheet4").Range("S" & suppno)

If supName <> "" Then
Sheets.Add
ActiveSheet.Name = supName

Sheets("Sheet4").Select
If ActiveSheet.AutoFilterMode Then
Cells.Select
Selection.AutoFilter
End If

Cells.Select
If ActiveSheet.AutoFilterMode = False Then
Selection.AutoFilter
End If

Selection.AutoFilter Field:=11, Criteria1:="1"

Lastrow = Cells(300, 19).End(xlUp).Row

Rows("1:" & Lastrow).Copy

'error: subsript out or range.......


Sheets(supName).Range("A1").PasteSpecial

End If
Next


Sheets("Sheet4").Select
If ActiveSheet.AutoFilterMode Then
Cells.Select
Selection.AutoFilter
End If
End Sub

---------------------------
I could not run though the whole macro as there is a "Subscript out of range" at Sheets(supName).Range("A1").PasteSpecial .....i tried to use filter as you said, but then the column which contain the YEAR would be gone after i applied it... what can i to solve the problem? MANY THANKS!

it might be more clear if you take a look at my onging file:
https://authentification.site/files/23882141/HOW.xls
Thanks! Please help!

and for some reason, a whole pile of data gone missing about i run the code...

Move your data in "S" column of sheet 4, to a new sheet and then you can use this macro. For this code, I have move the "S" column to a new sheet called "Search Years" and is it in its column A

Sub details()
Dim sUnqSht As String
Dim sSrcSht As String
Dim lSrcMaxRows As Long
Dim iLastCol As Integer
Dim iFilterRow As Long
Dim sYear As Long
Dim lUnqRow As Long
Dim Cell As Range

    On Error GoTo Err_Sub
    
    sUnqSht = "Search Years"
    
    sSrcSht = "Sheet4"
    
    Sheets(sSrcSht).Select
    
    Sheets(sSrcSht).AutoFilterMode = False
    Set Cell = Sheets(sSrcSht).Cells.Find("*", Cells(1, 1), SearchOrder:=xlByRows, searchdirection:=xlPrevious)
    
    If Cell Is Nothing Then
        GoTo Exit_Sub
    End If
    
    lSrcMaxRows = Cell.Row
    
    If lSrcMaxRows < 2 Then GoTo Exit_Sub
    
    
    Set Cell = Sheets(sSrcSht).Cells.Find("*", Cells(1, 1), SearchOrder:=xlByColumns, searchdirection:=xlPrevious)
    iLastCol = Cell.Column + 1
    
    Cells(1, iLastCol) = "Temp Col"
    Range(Cells(1, 1), Cells(iLastCol, lSrcMaxRows)).AutoFilter
    
    lUnqRow = 2
    Do While (Sheets(sUnqSht).Cells(lUnqRow, "A") <> "")
    
        sYear = Sheets(sUnqSht).Cells(lUnqRow, "A")
        
        With Range(Cells(2, iLastCol), Cells(lSrcMaxRows, iLastCol))
            .AutoFilter field:=iLastCol
            .FormulaR1C1 = "=IF(OR((YEAR(RC6)=" & sYear & "),(YEAR(RC7)=" & sYear & "),(YEAR(RC8)=" & sYear & ")),1,0)"
            .Copy
            .PasteSpecial xlPasteValues
            .AutoFilter field:=iLastCol, Criteria1:="=1"
        End With
        
        
        iFilterRow = Cells(Rows.Count, iLastCol).End(xlUp).Row
        
        On Error Resume Next
            Application.DisplayAlerts = False
            Sheets(CStr(sYear)).Delete
            Err.Clear
            Application.DisplayAlerts = True
        On Error GoTo Err_Sub
        
        Sheets.Add
        ActiveSheet.Name = sYear
        
        Sheets(sSrcSht).Select
        Range(Cells(1, 1), Cells(iFilterRow, iLastCol - 1)).Copy
        Sheets(CStr(sYear)).Select
        Range("A1").PasteSpecial
        
        Sheets(sSrcSht).Select
    
        lUnqRow = lUnqRow + 1
    Loop
    
    Sheets(sSrcSht).Select
    ActiveSheet.AutoFilterMode = False
    Range(Cells(1, iLastCol), Cells(lSrcMaxRows, iLastCol)).Clear
    

Exit_Sub:
    On Error Resume Next
    Application.CutCopyMode = False
    Set Cell = Nothing
    On Error GoTo 0
    Exit Sub
    
Err_Sub:
    MsgBox Err.Description
    GoTo Exit_Sub
End Sub

You are genious! The code works!
Thank so much.. i have been struggling on this for a whole week!