Send sheet to Archive workbook

scoha

Active Member
Joined
Jun 15, 2005
Messages
428
There are some posts dealing with archiving worksheets to an archive workbook but most assume all sheets or all workbooks get archived. I need a more selective macro that I am hoping someone can assist me with.

I have the following code:

Code:
Sub ArchiveResults()

Dim MyPath As Variant
Dim RDate As Date
Dim ws As Worksheet


On Error GoTo error_handler
Application.ScreenUpdating = False

'Gets the race date - this is a drop down event date in cell C2
RDate = Range("c2").Value

'sets the archive workbook being "RaceArchive.xlsm"
MyPath = ActiveWorkbook.Path & "\" & "RaceArchive.xlsm"

Workbooks.Open Filename:=MyPath

With Workbooks("Race_Sheet.xlsm").Sheets("Race sheet")
.UsedRange.Copy Workbooks("RaceArchive.xlsm").Sheets("Sheet1").Range("a1")
End With

Worksheet.Name = RDate

Application.ScreenUpdating = True
Exit Sub
error_handler:
End Sub

it copies the race sheet datra across to RaceArchive Ok but doesnt name the tab with the RDate variable as I want it to.

Also, how do I get it to create a new sheet, each time I run the archive macro - not just overwrite Sheet1?

Hope some one can help
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Hi,
Maybe you can get away with copying the whole sheet rather than the used range ... should be simpler (?) ... I tweaked a bit to set a reference to the archive workbook to make the code a little easier to read.

Code:
Sub ArchiveResults()

Dim MyPath As Variant
Dim RDate As Date
Dim ws As Worksheet
[COLOR="blue"]Dim wbArchive As Workbook[/COLOR]

On Error GoTo error_handler
Application.ScreenUpdating = False

[COLOR="SeaGreen"]'Gets the race date - this is a drop down event date in cell C2[/COLOR]
RDate = Range("c2").Value

[COLOR="seagreen"]'sets the archive workbook being "RaceArchive.xlsm"[/COLOR]
MyPath = ActiveWorkbook.Path & "\" & "RaceArchive.xlsm"

[COLOR="seagreen"]'reference to archive workbook[/COLOR]
Workbooks.Open Filename:=MyPath
[COLOR="blue"]Set wbArchive = ActiveWorkbook[/COLOR]

[COLOR="seagreen"]'copy whole sheet to archive[/COLOR]
[COLOR="Blue"]With wbArchive[/COLOR]
    [COLOR="Red"]Workbooks("Race_Sheet.xlsm").Sheets("Race sheet").Copy _
        After:=.Worksheets(.Worksheets.Count)
        .Worksheets(.Worksheets.Count).Name = RDate [/COLOR][COLOR="seagreen"]'new last sheet is RDate[/COLOR]
[COLOR="Blue"]End With[/COLOR]

Application.ScreenUpdating = True
Exit Sub
error_handler:
End Sub
 
Upvote 0
Thanks Alexander Barnes

Its very close - just two outstanding issues:

1. it doesnt rename the tab with RDate variable (obtained from cell "C2". RDate)
2. how can I paste values and formats and not include the forumlae and validations? I dont want any changes to inadvertently happen after the sheet is sent to archive

cheers
 
Upvote 0
1) Remove the error handler while testing - its probably erroring and therefore skipping the step - but what's the error? Duplicate sheet name? No value in RDate?

2) To copy all values try:
Code:
    Workbooks("Race_Sheet.xlsm").Sheets("Race sheet").Copy _
        After:=.Worksheets(.Worksheets.Count)
        .Worksheets(.Worksheets.Count).Name = RDate
        [COLOR="Blue"].Worksheets(.Worksheets.Count).UsedRange.Value = _
            .Worksheets(.Worksheets.Count).UsedRange.Value[/COLOR]

(Not tested - and we may be having trouble referencing that sheet too...)
 
Upvote 0
Thanks Alexander - took your tip and removed error handler. It proved I get a value in RDate and when I change the Dim definition of RDate to Long instead of date it actually names the archive sheet with the Excel date number - all good but results in an Object doesnt support this method error.

Knowing this how do I fix? How do you format RDate such that the tab looks like a date?

regards
 
Upvote 0
Just found the answer re date format from your post today (aacod) and it works nicely. So only outstanding issue is Object Doesnt Support this Method. No worries if I enable the error handler but should I still be worried that if I dont have an error handler the macro errors?
 
Upvote 0
hmmm....that's a bit odd. Not sure what that error is all about either. It bothers me also.

Here's a variation on a theme - try another tactic by creating the worksheet in the archive first, then copying values to it...

Code:
Sub ArchiveResults()

Dim MyPath As String
Dim RDate As Date
Dim ws As Worksheet
Dim wbArchive As Workbook

On Error GoTo error_handler

'Gets the race date - this is a drop down event date in cell C2
RDate = Range("c2").Value

'sets the archive workbook being "RaceArchive.xlsm"
MyPath = ActiveWorkbook.Path & "\" & "RaceArchive.xlsm"

'reference to archive workbook
If IsWorkbookOpen(FileNameOnly(MyPath)) Then
    Set wbArchive = Workbooks(FileNameOnly(MyPath))
Else
    Workbooks.Open Filename:=MyPath
    Set wbArchive = ActiveWorkbook
End If

'create new sheet in archive and copy values to it
Set ws = wbArchive.Worksheets.Add
ws.Name = Format(RDate, "mm-dd-yy")
Workbooks("Race_Sheet.xlsm").Sheets("Race sheet").UsedRange.Copy
ws.Cells(1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats


Exit Sub
error_handler:
End Sub
'--------------------------------------------------
Function IsWorkbookOpen(strWorkbookName) As Boolean
Dim strTemp As String

On Error Resume Next
strTemp = Workbooks(strTemp).Name

If Err Then
    IsWorkbookOpen = False
Else
    IsWorkbookOpen = True
End If

End Function
'----------------------------------------------
Function FileNameOnly(Arg1 As String) As String
    FileNameOnly = _
        StrReverse(Left(StrReverse(Arg1), InStr(1, StrReverse(Arg1), "\") - 1))
End Function
 
Upvote 0

Forum statistics

Threads
1,212,931
Messages
6,110,745
Members
448,295
Latest member
Uzair Tahir Khan

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
Back
Top