Copy range to new sheet with date stamp

[EvilC]

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.

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

 

[L. Howard]

Maybe like this?

Howard

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]

Wow, you make it look very easy

Thanks all i need.

PS.

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

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]

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

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]

OK, thanks a lot for your help, i just made sure that the range is never empty.