PDA

View Full Version : Archiving weekly data



lurchybold
12-20-2010, 04:55 AM
Hi,

I have found some code on here that almost does what I need it to do the code is:
Private Sub CommandButton2_Click()
Dim NewName As String
Dim nm As Name
Dim ws As Worksheet

If MsgBox("Copy specific sheets to a new workbook" & vbCr & _
"New sheets will be pasted as values, named ranges removed" _
, vbYesNo, "NewCopy") = vbNo Then Exit Sub

With Application
.ScreenUpdating = False

' Copy specific sheets
' *SET THE SHEET NAMES TO COPY BELOW*
' Array("Sheet Name", "Another sheet name", "And Another"))
' Sheet names go inside quotes, seperated by commas
On Error GoTo ErrCatcher
Sheets(Array("SAT Data")).Copy
On Error GoTo 0

' Paste sheets as values
' Remove External Links, Hperlinks and hard-code formulas
' Make sure A1 is selected on all sheets
For Each ws In ActiveWorkbook.Worksheets
ws.Cells.Copy
ws.[A1].PasteSpecial Paste:=xlValues
ws.Cells.Hyperlinks.Delete
Application.CutCopyMode = False
:banghead: Cells(1, 1).Select
ws.Activate
Next ws
Cells(1, 1).Select

' Remove named ranges
For Each nm In ActiveWorkbook.Names
nm.Delete
Next nm

' Input box to name new file
NewName = InputBox("Weekly SAT Records 2011", "New Copy")

' Save it with the NewName and in the same directory as original
ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xls"
ActiveWorkbook.Close SaveChanges:=False

.ScreenUpdating = True
End With
Exit Sub

ErrCatcher:
MsgBox "Specified sheets do not exist within this workbook"
End Sub

What I need is:

I have a file that contains a front sheet 'SAT Data' that is filled out every friday. This has links to trend analysis. What I need to do is save the front sheet to another file called 'Weekly SAT Records 2011' . Saved on a new sheet each time and named with the week commencing date in cell J1.

The above runs and falls over at the point with the head banging smiley. A copy is produced and opened up as 'Book1' then if I click th button again another copy is produced as 'Book2'

Can someone help me to sort this please,

By the way, I fumble through these codes with the elegance of an hippo i.e. I'm not that clued up !!!

Regards,

Andy.

Bob Phillips
12-20-2010, 06:46 AM
No head banging smiley that I can see.

lurchybold
12-21-2010, 02:25 AM
hI,

When posted the headbanging smiley didn't show up as a character the line that starts with :banghead: is the line where it stops, :banghead: is not part of the code !

Regards,

Andy

lurchybold
12-21-2010, 02:26 AM
[ : banghead : ]


gerrrrr

Bob Phillips
12-21-2010, 03:35 AM
Try this



For Each ws In ActiveWorkbook.Worksheets
ws.Cells.Copy
ws.[A1].PasteSpecial Paste:=xlValues
ws.Cells.Hyperlinks.Delete
Application.CutCopyMode = False
ws.Activate
ws.Cells(1, 1).Select
Next ws

lurchybold
12-21-2010, 05:00 AM
Thanks Xld,

after a little more fiddling now works brilliantly :cloud9:

One small problem, whan the sheet is saved the two buttons I have for 'Update' and 'Archive' are saved into the archive file along with the codeing. Is it posible to strip these off when archiving the sheet ?

Best regards,

Andy.

Bob Phillips
12-21-2010, 05:07 AM
What sort of buttons?

lurchybold
12-21-2010, 05:18 AM
Command Buttons

if that helps ?