ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   Auto Save (https://www.excelbanter.com/excel-discussion-misc-queries/69011-auto-save.html)

GarToms

Auto Save
 
Hi All,
I'm looking for vb code to use as a macro to copy a sheet, save it as the text in cell C5, and save it in a particular directory.

Does have something that can do this?

GarToms

I have got this code so far. It saves the file to my documents as the specified cell D5.
However
1.I want it to only save the 1 sheet 'Group Sign Off' instead of the 8 sheets in the workbook.
2. And it doesn't allow me to specify the save directory i.e.("L:\Credit Management Team\Gareth Thomas\".

does anyone know how to make these changes?

current code:

Sub SaveAsCell()
Dim strName As String

On Error GoTo InvalidName 'checks if filename D5 is valid
strName = Sheets("Group Sign-Off").Range("d5")
ActiveWorkbook.SaveAs strName

Exit Sub
'invalid filename output
InvalidName: MsgBox "The text: " & strName & _
" is not a valid file name.", vbCritical, "Ozgrid.com"
End Sub

GarToms

Hi again, i now have it saving to the correct directory, does anyone know how to change this to only save the sheet and not the workbook.

Thanks all

Code:

Sub SaveAsCell()
Dim strName As String

On Error GoTo InvalidName

Sheets("Group Sign-Off").SaveAs Filename:="L:\Credit Management Team\Gareth Thomas\" & _
Sheets("Group Sign-Off").Range("d5").Value & ".xls"



Exit Sub
InvalidName: MsgBox "The text: " & strName & _
" is not a valid file name.", vbCritical, "Ozgrid.com"
End Sub

vezerid

Auto Save
 
GarToms,

the following macro might give you a lead... It involves Select so
there will be some flashing on the screen. Another method could be to
modify this code to loop over all cells of origin and set values and
formats of all destination cells equal. UsedRange can make this
speedier than looping over the entire sheet.

Sub SaveSheetAsCell()
Dim newbk As Workbook
Dim oldCell As Range

Set oldCell = Selection
Set newbk = Workbooks.Add(xlWBATWorksheet)

ThisWorkbook.Sheets("Group Sign-Off").Cells.Copy
newbk.Sheets(1).Name = "Group Sign-Off"
newbk.Sheets("Group Sign-Off").Select
newbk.Sheets("Group Sign-Off").Paste

fpath = "L:\Credit Management Team\Gareth Thomas\"
fname = Sheets("Group Sign-Off").Range("d5").Value & ".xls"
newbk.SaveAs fpath & fname
newbk.Close

Application.CutCopyMode = False
oldCell.Select

End Sub

Does it help?
Kostis Vezerides


GarToms

Thats excellent, thanks a lot.

Quote:

Originally Posted by vezerid
GarToms,

the following macro might give you a lead... It involves Select so
there will be some flashing on the screen. Another method could be to
modify this code to loop over all cells of origin and set values and
formats of all destination cells equal. UsedRange can make this
speedier than looping over the entire sheet.

Sub SaveSheetAsCell()
Dim newbk As Workbook
Dim oldCell As Range

Set oldCell = Selection
Set newbk = Workbooks.Add(xlWBATWorksheet)

ThisWorkbook.Sheets("Group Sign-Off").Cells.Copy
newbk.Sheets(1).Name = "Group Sign-Off"
newbk.Sheets("Group Sign-Off").Select
newbk.Sheets("Group Sign-Off").Paste

fpath = "L:\Credit Management Team\Gareth Thomas\"
fname = Sheets("Group Sign-Off").Range("d5").Value & ".xls"
newbk.SaveAs fpath & fname
newbk.Close

Application.CutCopyMode = False
oldCell.Select

End Sub

Does it help?
Kostis Vezerides



All times are GMT +1. The time now is 11:02 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com