Related:

- Copy / paste specfic DATE to other worksheet.
- Copy paste rows in Excel across worksheets ✓ - Forum - Excel
- Copy x rows from a worksheet and paste x rows into another worksheet n times ✓ - Forum - Excel
- Compare two worksheets and paste differences to another sheet - excel vba free download ✓ - Forum - Excel
- Compare two worksheets and paste differences to another sheet - excel vba ✓ - Forum - Excel
- Macro to compare two excel sheets ✓ - Forum - Excel

rizvisa1

- Posts
- 4476
- Registration date
- Thursday January 28, 2010
- Status
- Contributor
- Last seen
- August 2, 2020

You can add this formula

=IF(OR(AND(B$17<>"",OR(YEAR(I2)=B$17,YEAR(J2)=B$17,YEAR(K2)=B$17)),AND(B$18<>"",OR(YEAR(I2)=B$18,YEAR(J2)=B$18,YEAR(K2)=B$18))),1,0)

Filter on "1"

Copy the range

If you need macro, you can record your action

=IF(OR(AND(B$17<>"",OR(YEAR(I2)=B$17,YEAR(J2)=B$17,YEAR(K2)=B$17)),AND(B$18<>"",OR(YEAR(I2)=B$18,YEAR(J2)=B$18,YEAR(K2)=B$18))),1,0)

Filter on "1"

Copy the range

If you need macro, you can record your action

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!

https://authentification.site/files/23882141/HOW.xls

Thanks! Please help!

Thank so much.. i have been struggling on this for a whole week!