Solved: save sheet to desktop with name from cell

[danovkos]

Hi all, how can i put together this 2 codes?
And how can i give a name to saved file based on content of cell C9?

I tried it, but it doesnt works.

I need save only active sheet to desktop (there is not specified concrete path, i want to use it to many computers) with name from content of cell C9 and actual date.

thx.

Sub SaveTOdesktop()
Rem With ActiveWorkbook
With ActiveWorkbook
  .saveas CreateObject("WScript.Shell").SpecialFolders("DeskTop") & Application.PathSeparator & .Name
End With
 
End Sub
Sub SaveAndDate()
   Worksheets("navrh").Copy
   ActiveWorkbook.saveas Filename:= _
   ThisWorkbook.Path & "/" & ActiveSheet.Name & " " & Format(Date, "dd mmm yyyy"), FileFormat:= _
   xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=True, _
   CreateBackup:=False
End Sub

[GTO]

Greetings Danovkos,

I believe this should work okay.

[vba]
Option Explicit
Sub SaveActiveSheet()
Dim wb As Workbook
Dim wksActive As Worksheet
Dim strUserDesktop As String
Dim strNewName As String

'// Set a reference to the ActiveSheet, then create the new filename. //
Set wksActive = ThisWorkbook.ActiveSheet
strNewName = wksActive.Range("C9") & Chr(32) & Format(Date, "dd mmm yyyy") & ".xls"

'// Set a reference to a new one sheet workbook. //
Set wb = Workbooks.Add(xlWBATWorksheet)

'// Get the current user's path to Desktop //
strUserDesktop = CreateObject("Wscript.Shell").SpecialFolders("Desktop") _
& Application.PathSeparator

'// With the new wb, copy our previously active sheet to it, delete the //
'// one blank sheet that the new wb was created with, then SaveAs. //
With wb
wksActive.Copy .Sheets(1)
Application.DisplayAlerts = False
.Sheets(2).Delete
Application.DisplayAlerts = True
.SaveAs strUserDesktop & strNewName
End With
End Sub
[/vba]

Hope that helps,

Mark

[danovkos]

yes, this works perfect, great code
thx a lot

[danovkos]

sorry, a little detail yet, maybe offtopic.
how can i define object. Because i want to change all of data in new saved file only to value

i tried this, but it doesnt works
still problem with define object
thx

Sub SaveTODesktop()
    Dim wb As Workbook
    Dim wksActive As Worksheet
    Dim strUserDesktop As String
    Dim strNewName As String
 
     '// Set a reference to the ActiveSheet, then create the new filename.   //
    Set wksActive = ThisWorkbook.ActiveSheet
    strNewName = wksActive.Range("C9") & Chr(32) & Format(Date, "dd mmm yyyy") & ".xls"
 
     '// Set a reference to a new one sheet workbook.                        //
    Set wb = Workbooks.Add(xlWBATWorksheet)
 
     '// Get the current user's path to Desktop                              //
    strUserDesktop = CreateObject("Wscript.Shell").SpecialFolders("Desktop") _
    & Application.PathSeparator
 
     '// With the new wb, copy our previously active sheet to it, delete the //
     '// one blank sheet that the new wb was created with, then SaveAs.      //
    With wb
        wksActive.Copy .Sheets(1)
        Application.DisplayAlerts = False
        .Sheets(2).Delete
        Application.DisplayAlerts = True
        .SaveAs strUserDesktop & strNewName
 
  Windows(strNewName).Activate
    Sheets("navrh").Select
    Range("A1:J1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("A1:J96").Select
    Selection.Copy
    Application.CutCopyMode = False
    Range("A1").Select
      End With
End Sub

[GTO]

Greetings again,

That is not a problem w/the object; you switched to addressing the Window, which is another object alltogether.

Glad you checked back, as I happen to think about something on the way home. Presuming you are having other users use the wb, we might want to block them from the chance ("chance" meaning it will happen for sure when you are busy or off on vacation...) bad entry for a filename.

This will prevent the user from entering illegal characters in C9 for the new filename. Not so sure on whether it will correctly sub vals for formulas, but here's a stab, as I have to hit the rack...

[vba]
Option Explicit

Sub SaveActiveSheet()
Dim wb As Workbook
Dim wksActive As Worksheet
Dim strUserDesktop As String
Dim strNewName As String

If IllegalName(ActiveSheet.Range("C9")) Then
MsgBox "You cannot use any of the following characters as part" & vbCrLf & _
"of the filename:" & String(2, vbCrLf) & _
vbTab & "< > ? [ ] : | *" & String(2, vbCrLf) & _
"Please re-enter a filename in C9.", vbCritical, vbNullString

ActiveSheet.Range("C9").ClearContents
Exit Sub
End If

'// Set a reference to the ActiveSheet, then create the new filename. //
Set wksActive = ThisWorkbook.ActiveSheet
strNewName = wksActive.Range("C9") & Chr(32) & Format(Date, "dd mmm yyyy") & ".xls"

'// Set a reference to a new one sheet workbook. //
Set wb = Workbooks.Add(xlWBATWorksheet)

'// Get the current user's path to Desktop //
strUserDesktop = CreateObject("Wscript.Shell").SpecialFolders("Desktop") _
& Application.PathSeparator

'// With the new wb, copy our previously active sheet to it, delete the //
'// one blank sheet that the new wb was created with, then SaveAs. //
With wb
wksActive.Copy .Sheets(1)
Application.DisplayAlerts = False
.Sheets(2).Delete
Application.DisplayAlerts = True
'***Change here.***
.Sheets(1).UsedRange.Value = .Sheets(1).UsedRange.Value

.SaveAs strUserDesktop & strNewName
End With
End Sub

Function IllegalName(FName As String) As Boolean
Dim a()
Dim i As Long

a = Array("<", ">", "?", "[", "]", ":", "|", "*")
For i = LBound(a()) To UBound(a())
If Not InStr(1, FName, a(i), vbTextCompare) = 0 Then
IllegalName = True
Exit For
End If
Next
End Function
[/vba]

Hope this helps,

Mark

[danovkos]

thank you very much...this works great