Here a example, and I add also the code to make values of all cells
It close the original file without saving (change to true if you want to save)
I add a reference to the original file in the code
Set wb = ActiveWorkbook
Sub Test4()
Dim fname As Variant
Dim wb As Workbook
Dim NewWb As Workbook
Dim MyPath As String
Dim SaveDriveDir As String
SaveDriveDir = CurDir
MyPath = "C:\"
ChDrive MyPath
ChDir MyPath
Set wb = ActiveWorkbook
ActiveSheet.Copy
Set NewWb = ActiveWorkbook
'Change all cells in the worksheet to values
With NewWb.Sheets(1).UsedRange
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
.Cells(1).Select
End With
Application.CutCopyMode = False
fname = Application.GetSaveAsFilename("myfile", _
fileFilter:="Excel Files (*.xls), *.xls")
If fname < False Then
NewWb.SaveAs fname
wb.Close False ' close without saving
Set NewWb = Nothing
Else
NewWb.Close False
Set NewWb = Nothing
End If
ChDrive SaveDriveDir
ChDir SaveDriveDir
End Sub
--
Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm
"Dave M" wrote in message ...
Thanks alot, I couldn't have done this without you!! One last question you
may know the answer to, when coping and closing, can you close the original
file instead of the copy?
"Ron de Bruin" wrote:
Hi Dave
Try this for
MyPath = "C:\"
Sub Test3()
Dim fname As Variant
Dim NewWb As Workbook
Dim MyPath As String
Dim SaveDriveDir As String
SaveDriveDir = CurDir
MyPath = "C:\"
ChDrive MyPath
ChDir MyPath
ActiveSheet.Copy
Set NewWb = ActiveWorkbook
fname = Application.GetSaveAsFilename("myfile", _
fileFilter:="Excel Files (*.xls), *.xls")
If fname < False Then
NewWb.SaveAs fname
NewWb.Close False
Set NewWb = Nothing
Else
NewWb.Close False
Set NewWb = Nothing
End If
ChDrive SaveDriveDir
ChDir SaveDriveDir
End Sub
--
Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm
"Dave M" wrote in message ...
Thanks, I does just what I want! Well, almost.... Do you know if there is a
way to change the default save directory away from the current files save
path to another place?
"Ron de Bruin" wrote:
Use this one that also close the new file if you not save it
Sub Test2()
Dim fname As Variant
Dim NewWb As Workbook
ActiveSheet.Copy
Set NewWb = ActiveWorkbook
fname = Application.GetSaveAsFilename("myfile", _
fileFilter:="Excel Files (*.xls), *.xls")
If fname < False Then
NewWb.SaveAs fname
NewWb.Close False
Set NewWb = Nothing
Else
NewWb.Close False
Set NewWb = Nothing
End If
End Sub
--
Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm
"Dave M" wrote in message ...
These answers are helpful, but what I'm looking to do is simply open the save
as dialoge box and let each user select where to file away the document,
hopefully with a default name (lets say, "123.xls" in cell x1), with an
option to change the name, just like a normal save as
Any ideas?
"Ron de Bruin" wrote:
Hi Dave
Try this example to save the ActiveSheet in a new workbook
Working in 97-2007.
If you are sure that this macro will not be used in 2007 the code can be shorter.
Sub Copy_ActiveSheet()
'Working in Excel 97-2007
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
'Copy the sheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
'We exit the sub when your answer is NO in the security dialog that you only
'see when you copy a sheet from a xlsm file with macro's disabled.
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With
'Change all cells in the worksheet to values if you want
With Destwb.Sheets(1).UsedRange
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
.Cells(1).Select
End With
Application.CutCopyMode = False
'Save the new workbook and close it
TempFilePath = Application.DefaultFilePath & "\"
TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
.Close SaveChanges:=False
End With
MsgBox "You can find the new file in " & Application.DefaultFilePath
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
--
Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm
"Dave M" wrote in message ...
Hello,
I am new to VB and need a code to print the sheet and then do a save as.
The file is going to be a read only with multiple users getting the form,
filling it out, printing it and then needing to save the completed form to
their own network drive (each user has their own mapped drive from the server
as F:\).
I can get the printing code down no problem, but am running into some
problems trying to save as.
Is there also a way to save only one sheet of the workbook whose values are
pulled from the other sheets? i.e. a paste special, values only?
Does anyone have any suggestions?
Thanks for your help
Dave