Copy range to new sheet with date stamp

EvilC

Board Regular
Joined
Jul 26, 2014
Messages
74
Hey all,

As i don't know much about VBA i hope i can explain what i need to you guys.

I have a workbook with daily results. Now i need to copy these results daily using a button into another sheet.
Lets say Sheet Calculation range A31:E31 into Sheet HistoricalData range, new row, while adding a datestamp in this sheet.

I have the following that will copy and select the new row for each day. Now i need to add a datestamp for each time i copy this range.

Code:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet


Set copySheet = Worksheets("PivotsTotals")
Set pasteSheet = Worksheets("HistoricalData")


copySheet.Range("D31:H31").Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox ("Record Added")
End Sub
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.

L. Howard

Well-known Member
Joined
Oct 16, 2012
Messages
4,514
Maybe like this?

Howard


Code:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet


Set copySheet = Worksheets("PivotsTotals")
Set pasteSheet = Worksheets("HistoricalData")

copySheet.Range("D31:H31").Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
pasteSheet.Cells(Rows.Count, 6).End(xlUp).Offset(1, 0) = Date
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox ("Record Added")
End Sub
 

EvilC

Board Regular
Joined
Jul 26, 2014
Messages
74
Wow, you make it look very easy :cool:

Thanks all i need.

PS.

If i wanted the date in the first column i could do:

Code:
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = Date
pasteSheet.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

correct??
 

L. Howard

Well-known Member
Joined
Oct 16, 2012
Messages
4,514
May be safer to do this. Where you will go up to the 'just pasted date cell' and offset for the 5 data items.
If the column D cell (first data cell in the row) is ever a blank at any time, you got problems aligning the data with the date.

Howard

Code:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet


Set copySheet = Worksheets("PivotsTotals")
Set pasteSheet = Worksheets("HistoricalData")

copySheet.Range("D31:H31").Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = Date
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(, 1).PasteSpecial xlPasteValues

Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox ("Record Added")
End Sub
 

EvilC

Board Regular
Joined
Jul 26, 2014
Messages
74
OK, thanks a lot for your help, i just made sure that the range is never empty.
 

Forum statistics

Threads
1,136,274
Messages
5,674,772
Members
419,525
Latest member
helensesc

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top