Change Directory, Save As

[dantb]

Hello all: The below saves one sheet in a workbook and gives it the name of what ever is in cell (A1). The problem I have is I need to save it to a sub directory under c:\A Temp, which are many, is there a way to have the Save as box come up starting at (c:\A Temp Folder) where I can pick a sub directory and then it will save as cell (A1)’s value?

Sub Save23()
Application.ScreenUpdating = False
ActiveSheet.Select
ActiveSheet.Copy
ThisFile = Range("A1").Value
ChDir "C:\"
ActiveSheet.SaveAs Filename:="C:\A Temp\" & ThisFile & ".xls"
ActiveWorkbook.Close
Application.ScreenUpdating = True
End Sub

 

[yeheya]

Hope this will help:

Sub Save23()
Dim strFile As String
Application.ScreenUpdating = False
ActiveSheet.Select
ActiveSheet.Copy
Thisfile = Range("A1").Value
ChDir "C:\A Temp"
strFile = Application.GetSaveAsFilename(Thisfile, "Excel File (*.xls),*.xls")
ActiveSheet.SaveAs Filename:=strFile & ".xls"
ActiveWorkbook.Close
Application.ScreenUpdating = True
End Sub

Regards,
Yeheya

 

[dantb]

Thank you yeheya, Works perfect. Dan