Copy / paste specfic DATE to other worksheet. [Solved/Closed]

Question

Copy / paste specfic DATE to other worksheet. [Solved/Closed]

Report

carman - Aug 13, 2010 at 03:59 AM
carman - Aug 22, 2010 at 09:06 PM

Hello,
I've got a few columns of data in which 3 columns contain dates (in date format : dd/mm/yyyy) . Now, I want excel to seperate the entire row into another worksheet according to the YEAR in the 3 columns.

In cell ( 17,B) and (18,B), i type in the year for reference ( which i want excel to seperate the rows accoding to this year) . * The year is not in "absolute term" and so the macro needs to be capable to capture the value in cell (17,B) and (18,B).

For example::
If i typed in "2011" in cell ( 17,B) and "2012" in cell ( 18,B), i want excel to look through the 3 columns (I to K),copy the entire row if the years in ANY of the column ( I to K) contains year of 2011 and 2012 and paste them in sheet 2.

Please take a look at this reference file:
https://authentification.site/files/23779983/01.xls

In this file, i want to seperate the entire rows from column (E to M) in sheet 1 to sheet 2. And sheet 3 is approximately the final product i want. I need a VBA code for this....

Thanks! I couldn't find relavent information on google...

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

1 reply

Ask a question

rizvisa1 · Answer 1 · 2010-08-17T23:19:22-0400

Answer 1 / 1

rizvisa1

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

763
Aug 17, 2010 at 11:19 PM

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

View all 10 comments

Report

carman
Aug 20, 2010 at 02:44 AM

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!

Report

carman
Aug 20, 2010 at 02:53 AM

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

Report

carman
Aug 20, 2010 at 02:54 AM

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

Report

rizvisa1

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

763
Aug 20, 2010 at 08:01 AM

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

Report

carman
Aug 22, 2010 at 09:06 PM

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

Copy / paste specfic DATE to other worksheet. [Solved/Closed]

1 reply

Your reply

Subscribe To Our Newsletter!