Macro for If date matches then paste value

[ElizS]

I have daily target figures (B2) that get manaully entered into a report sheet (Sheet 1) every morning. I want to be able to copy and paste the values on a separate sheet (Sheet 2) so I can track and store the daily target figures because they get overridden every morning and I want a backup for graphing.

I can get the current day's target figures into Sheet 2 with the formula =IF(A4=TODAY(),'Sheet1'!$B$2,NA()). Where Column A on Sheet 2 is just the dates for this month and Cell B2 on Sheet 1 is the target figures I want copied.

The problem with this is that it will only show the target figure for that day as it doesn't paste value the figures from previous days.

So what I need help with is creating a macro that takes a snapshot of the value in B2 on Sheet 1 and pastes the value on the correct row in Sheet 2 corresponding to today's date. I don't want to have to manually paste value everyday, I want to be able to hit a button and it copy the figure for me. Thanks!

E.g.
Sheet 1

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD][/TD]
[TD]3/11/16 [=today()][/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Daily Target[/TD]
[TD]20[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Sheet 2
[TABLE="class: outer_border, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD][/TD]
[TD]Daily Target[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]1/11/16[/TD]
[TD]25[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]2/11/16[/TD]
[TD]30[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]3/11/16[/TD]
[TD]20[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]4/11/16[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]5/11/16[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[My Aswer Is This]

Can we tell the script to paste the value from Sheet(1) Range "B2"

Into the first empty cell in Sheet(2) Column "B"

This way we do not have to search Sheet(2) column "A" for the value in Sheet(1) Range "B1"

 

[ElizS]

Yes, that would work as all the previous cells would have data in them

 

[My Aswer Is This]

Try this:

Make sure your sheets are named "Sheet1" & "Sheet2"

Sub My_Goals()
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Lastrow = Sheets("Sheet2").Cells(Rows.Count, "B").End(xlUp).Row + 1
Sheets("Sheet1").Range("B2").Copy Destination:=Sheets("Sheet2").Range("B" & Lastrow)
Application.ScreenUpdating = False
End Sub

 

[ElizS]

It worked! Thank you!

 

[My Aswer Is This]

Glad I was able to help you. Come back here to Mr. Excel next time you need additional assistance.

It worked! Thank you!