vba copy sheet new

Forum home » Delegate support and help forum » Microsoft Excel VBA Training and help » VBA to copy sheet to a new book as values | Excel forum

VBA to copy sheet to a new book as values | Excel forum

resolvedResolved · Low Priority · Version 2003

Andy has attended:
No courses

VBA to copy sheet to a new book as values

Hi there

I have found the following code on the internet which enables me to copy the active sheet in a workbook to a new sheet keeping the formatting but replacing formulas with values. This code in in my personal workbook but what happens is evertime I run it a copy gets saved in my xlstart folder which means unless I move/delete I get mulitple sheets open when I open excel - could you have a look and let me know what I need to change

Sub CopyActiveSheetToNewBookValues()
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.
ActiveSheet.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
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("Please Specify the name of your new workbook", "New Copy")

' Save it with the NewName and in the same directory as original
ActiveWorkbook.SaveAs 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

RE: VBA to copy sheet to a new book as values

Hi Andy, thanks for your query. When you say you "get mulitple sheets open when I open excel" that certainly shouldn't be happening unless the subroutine is part of an Auto-Open subroutine, unless the code above is being called elsewhere. Also, the line "ActiveWorkbook.SaveAs ThisWorkbook.Path" worries me, I'd prefer more control from the start but defining the destination filepath in a variable and citing that throughout the code. Personally, if cannibilising this from the net, I would have kept the Paste-Special statements and rebuilt the rest of the subroutine. Try copying that part out and running it in isolation and then rebuilding the file outputs from scratch.

Hope this helps,

Anthony

Thu 7 Oct 2010: Automatically marked as resolved.

 

Training courses

 

Training information:

Welcome. Please choose your application (eg. Excel) and then post your question.

Our Microsoft Qualified trainers will then respond within 24 hours (working days).

Frequently Asked Questions
What does 'Resolved' mean?

Any suggestions, questions or comments? Please post in the Improve the forum thread.


 

Excel tip:

Autofit column width – Excel (all versions)

a. Highlight the column or columns you wish to alter the width of. You do this by clicking on the grey button at the top of the column showing the column letter. Click and drag on these letters to select more than one column.
b. Double click the dividing line between the columns. This dividing line is the break between the columns on the column headers (grey buttons showing the column letter at the top of each column). When you hover your mouse over one of these dividing lines the point will change and show an arrow pulling a line in two directions. When you have this mouse pointer you should double click to get Excel to automatically set the column width to fit the contents of the column (autofit)

View all Excel hints and tips


Server loaded in 0.09 secs.