SaveAs macro

You can save a workbook as a copy of the existing workbook with a file name from a cell in the original workbook and close it. Then, close the original workbook without saving the changes.

The problem is once you close the original workbook, the macro code to re-open the original workbook is in the closed workbook. So, you can't open the workbook without a shell workbook to hold the code! JSW

Sub CellSave()
Dim CSName As String
Dim OldPath As String
Dim OldFName As String
'This is the cell containing the name for the new book.
CSName = Worksheets("Sheet1").Range("A1").Value

'This is the code to get path & Name data, not used.
'OldPath = ActiveWorkbook.Path
'MsgBox OldPath
'OldFName = ActiveWorkbook.Name
'MsgBox OldFName

ActiveWorkbook.Sheets.Select

'Make a copy of the original workbook.
Sheets.Copy
ActiveSheet.Activate

'Save the new workbook.
ActiveWorkbook.SaveAs (CSName)

'Close the new saved workbook.
ActiveWorkbook.Close

'Close the original workbook, do not save.
ActiveWorkbook.Close (False)

End Sub

Thanks for helping my thinking, Joe.

In this case, the original workbook is a read-only template that I created. Data are entered and the workbook is "saved as" the name of a calculated cell, then closed.

When the template is reopened, the data cells are empty and ready to be repopulated.

I think I can use your code for the "save as" part of the macro, then include another statement to clear the data cells on the template. Then, the only problem is to close the newly-created workbook.

Any further suggestions would be greatly appreciated.

Thanks!

. . . except that the template will no longer be open. Now is see the value of creating a copy before "save as calculated cell." Let me spell out the scenario again, adjusted by your comment.

1) I have a read-only template that will be populated with data. A certain cell contains a calculated value that I want to use as they name of the saved data.

2) I copy the workbook and give it the name of the calculated cell.

3) I close the new workbook.

4) I clear the values in the template, so it is ready for the next set of data.

I think I can get this done now, although I'd appreciate any further suggestions. Thanks again.

King

I think this may help you out;
It essentially works of the workbook befoe close
event....prompts you for the dir to save to
Prompts for the password
then attempts to save as your named range
In this case I've prmg it for sheet1 A1
Change as required............

PLEASE TEST....before implimenting as I haven't
fully tested it....
I've commented where poss POST if unsure

IN the ThisWorkbook Object place this code;

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim sQ As String
ThisWorkbook.Saved = True
sQ = MsgBox("Do you wish to save this workbook ?", vbYesNoCancel)
If sQ = vbCancel Then Cancel = True
If sQ = vbYes Then
If FSaveAs = False Then
Cancel = True
End If
End If
End Sub

In a Module place this code;

Option Explicit

Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

'Converts an item identifier list to a file system path.
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
'· pidl
'Pointer to an item identifier list that specifies a file or directory
'location relative to the root of the name space (the desktop).

'· pszPath
'Pointer to a buffer that receives the file system path.
'The size of this buffer is assumed to be MAX_PATH = 260 bytes.

'Returns a pointer to an item identifier list that specifies the location of
'the selected folder relative to the root of the name space. If the user
'chooses the Cancel button in the dialog box, the return value is NULL.
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
'lpbrowseinfo = Pointer to a BROWSEINFO structure that contains information
'used to display the dialog box.

Function GetFolderName(msg As String) As String
' returns the name of the folder selected by the user
Dim bInfo As BROWSEINFO, path As String, r As Long, X As Long, pos As Integer

bInfo.pidlRoot = 0& ' Root folder = Desktop

If IsMissing(msg) Then
bInfo.lpszTitle = "Select a folder." ' the Default dialog title
Else
bInfo.lpszTitle = msg ' the User defined dialog title
End If

bInfo.ulFlags = &H1 ' Type of directory to return
X = SHBrowseForFolder(bInfo) ' display the dialog
path = Space$(512) ' Parse the result
r = SHGetPathFromIDList(ByVal X, ByVal path) '

If r Then
pos = InStr(path, Chr$(0))
GetFolderName = Left(path, pos - 1)
Else
GetFolderName = ""
End If

End Function

Function FSaveAs() As Boolean
Dim sDir As String
Dim sFilePwd As String
Dim sFileName As String

FSaveAs = False

sDir = GetFolderName("Please Select a folder to SaveTo")
If sDir = "" Then Exit Function

sFilePwd = Application.InputBox("Enter password", Type:=2)
If sFilePwd = "False" Then Exit Function

sFileName = Sheet1.[A1]

On Error GoTo FileError
ActiveWorkbook.SaveAs Filename:=sDir & "\" & sFileName, _
FileFormat:=xlNormal, Password:=sFilePwd
FSaveAs = True
Exit Function
FileError:
MsgBox Err.Number & Chr(13) & _
Err.Description & Chr(13), _
vbCritical + vbMsgBoxHelpButton, "ERROR", _
Err.HelpFile, Err.HelpContext
FSaveAs = False
End Function

HTH

Ivan

Disregard the above Wrong Thread !