VBA Copy Row based off cell value

[floggingmolly]

I am needing some help here. I have a sheet that has dates in column O. I have a code that copies dates based off a date, but I have to enter the date into the code. I would like to be able to enter a date in say cell A1 and then run the code to copy the rows based off the date I enter in A1. Below is the code I have so far. Can anyone help me out?

Sub CopyRows()
a = Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
 For i = 2 To a
 
 If Worksheets("Sheet1").Cells(i, 15).Value = "4/10/2020" Then
 
 Worksheets("Sheet1").Rows(i).Copy
 Worksheets("Sheet2").Activate
 b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
 Worksheets("Sheet2").Cells(b + 1, 1).Select
 ActiveSheet.Paste


 
 End If
 Next
 


End Sub

 

[Scott T]

Try

Note: you do not need to activate sheet2 if you do not want to. Also you do not need the select the cell.

Sub CopyRows()
a = Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
 
 For i = 2 To a
 
    If Worksheets("Sheet1").Cells(i, 15) = Sheets("Sheet1").Cells(1, 1) Then
    Worksheets("Sheet1").Rows(i).Copy
    Worksheets("Sheet2").Activate
    b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("Sheet2").Cells(b + 1, 1).Select
    ActiveSheet.Paste
 End If
 Next

End Sub

Without activating sheet and selecting cell

Sub CopyRows()
a = Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
 
 For i = 2 To a
 
    If Worksheets("Sheet1").Cells(i, 15) = Sheets("Sheet1").Cells(1, 1) Then
    b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("Sheet1").Rows(i).Copy Worksheets("Sheet2").Cells(b + 1, 1)
    
 End If
 Next

End Sub

 

[floggingmolly]

Try

Note: you do not need to activate sheet2 if you do not want to. Also you do not need the select the cell.

Sub CopyRows()
a = Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
 
 For i = 2 To a
 
    If Worksheets("Sheet1").Cells(i, 15) = Sheets("Sheet1").Cells(1, 1) Then
    Worksheets("Sheet1").Rows(i).Copy
    Worksheets("Sheet2").Activate
    b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("Sheet2").Cells(b + 1, 1).Select
    ActiveSheet.Paste
 End If
 Next

End Sub

Without activating sheet and selecting cell

Sub CopyRows()
a = Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
 
 For i = 2 To a
 
    If Worksheets("Sheet1").Cells(i, 15) = Sheets("Sheet1").Cells(1, 1) Then
    b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("Sheet1").Rows(i).Copy Worksheets("Sheet2").Cells(b + 1, 1)
    
 End If
 Next

End Sub

Thank you so much. This worked perfectly. I appreciate your help.