• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

values to another sheet based on the date criteria results

Tharabai

Member
Hi All,

Help on the below pls...

Sheet2 – Column P (date column). If the cell value in the column P is greater than or equal to today’s date, then the detail to be picked to sheet3 after the last used row.
Details to be picked from sheet2 to sheet3

1. Cell value of column P in sheet2 to column P of sheet3 after the last used row
2. Corresponding cell value of column D in sheet2 to column Q of sheet3 after the last used row
 
Code:
Sub copier()

Dim Sht2Row, Sht3Row As String

'Start row is 2
Worksheets("Sheet2").Select
Range("P2").Select
'Assumes Date column is not blank in Sheet2
Do Until IsEmpty(ActiveCell)
    If ActiveCell.Value >= Date Then
        Sht2Row = ActiveCell.Row
        ActiveCell.Copy
        Worksheets("Sheet3").Select
        Range("P" & Cells(Rows.Count, "P").End(xlUp).Offset(1, 0).Row).Select
        Sht3Row = ActiveCell.Row
        ActiveSheet.Paste
        Worksheets("Sheet2").Select
        Range("D" & Sht2Row).Copy
        Worksheets("Sheet3").Select
        Range("Q" & Sht3Row).Select
        ActiveSheet.Paste
        Worksheets("Sheet2").Select
        Range("P" & Sht2Row).Select
        ActiveCell.Offset(1, 0).Select
    Else
    End If
Loop

End Sub
 
Hi,

Thank you for the coding.

I tried to modify the below line to paste the output as values

ActiveSheet.PasteSpecial xlPasteValues

But I got an error message.. could you please assist
 
You'll need to apply your own date format as it'll paste as values

Code:
Sub copier()

Dim Sht2Row, Sht3Row As String

'Start row is 2
Worksheets("Sheet2").Select
Range("P2").Select
'Assumes Date column is not blank in Sheet2
Do Until IsEmpty(ActiveCell)
    If ActiveCell.Value >= Date Then
        Sht2Row = ActiveCell.Row
        ActiveCell.Copy
        Worksheets("Sheet3").Select
        Range("P" & Cells(Rows.Count, "P").End(xlUp).Offset(1, 0).Row).Select
        Sht3Row = ActiveCell.Row
        Selection.PasteSpecial xlPasteValues
        Worksheets("Sheet2").Select
        Range("D" & Sht2Row).Copy
        Worksheets("Sheet3").Select
        Range("Q" & Sht3Row).Select
        Selection.PasteSpecial xlPasteValues
        Worksheets("Sheet2").Select
        Range("P" & Sht2Row).Select
        ActiveCell.Offset(1, 0).Select
    Else
    End If
Loop

End Sub
 
Back
Top