[[email protected]]

Hello,
I am trying to copy a sheet, saving as a new workbook, values & number formats
also with the filename taken from (A1) all with the click of a button, sounds easy!
here is the macro

Dim myFileName As String
With ActiveWorkbook
* *worksheets(1).Copy 'to a new workbook
* with active sheet with.UsedRange.
Copy.PasteSpecial Paste:=xlPasteValues 'remove formulas??? *
'pick up the name from some cells???
*myfilename = .range("a1").value & ".xls" myfilename = "C:\Users\Ditchy\Desktop\" & myfilename *'????
..Parent.SaveAs Filename:=myFileName, FileFormat:=xlWorkbookNormal
..Parent.Close savechanges:=False
End With
End Sub

any and all help appreciated

regards
Ditchy
Ballarat
Australia

[Claus Busch]

Hi Ditchy,

Am Mon, 12 May 2014 00:29:43 -0700 (PDT) schrieb
:

I am trying to copy a sheet, saving as a new workbook, values & number formats
also with the filename taken from (A1) all with the click of a button, sounds easy!
here is the macro

try:

Sub Test()
Dim myFileName As String
Dim myPath As String

myPath = "C:\Users\Ditchy\Desktop\"
Worksheets(1).Copy

With ActiveSheet
myFileName = .Range("A1").Value & ".xls"
With .UsedRange
.Value = .Value
End With
End With

With ActiveWorkbook
.SaveAs Filename:=myPath & myFileName, FileFormat:=xlWorkbookNormal
.Close
End With
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

[[email protected]]

Hi Claus,
thanks for your help.
Macro comes up with '400 error'
and does not copy and paste values & number formats to desktop with file name?
have you any more suggestions please

regards
Ditchy

On Monday, May 12, 2014 5:29:43 PM UTC+10, wrote:
Hello,

I am trying to copy a sheet, saving as a new workbook, values & number formats

also with the filename taken from (A1) all with the click of a button, sounds easy!

here is the macro



Dim myFileName As String

With ActiveWorkbook

* *worksheets(1).Copy 'to a new workbook

* with active sheet with.UsedRange.

Copy.PasteSpecial Paste:=xlPasteValues 'remove formulas??? *

'pick up the name from some cells???

*myfilename = .range("a1").value & ".xls" myfilename = "C:\Users\Ditchy\Desktop\" & myfilename *'????

.Parent.SaveAs Filename:=myFileName, FileFormat:=xlWorkbookNormal

.Parent.Close savechanges:=False

End With

End Sub



any and all help appreciated



regards

Ditchy

Ballarat

Australia

[Claus Busch]

Hi Ditchy,

Am Mon, 12 May 2014 01:37:38 -0700 (PDT) schrieb
:

Macro comes up with '400 error'
and does not copy and paste values & number formats to desktop with file name?
have you any more suggestions please

if you run the macro from another sheet than Worksheets(1) try:

Sub Test()
Dim myFileName As String
Dim myPath As String

myPath = "C:\Users\Ditchy\Desktop\"
myFileName = ThisWorkbook.ActiveSheet.Range("A1").Value & ".xls"

Worksheets(1).Copy
With ActiveSheet.UsedRange
.Value = .Value
End With

With ActiveWorkbook
.SaveAs Filename:=myPath & myFileName, FileFormat:=xlWorkbookNormal
.Close
End With
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

[[email protected]]

Hi Claus,
I still have no luck getting it to work.
Is there a way you could modify this one to copy and save as values and number formats in C:\Users\Ditchy\Desktop\. ?
This macro works but copies to desktop & does not save as values and number formats



Sub WorkbookSaveCopyAs2()
'use the Workbook.SaveCopyAs Method to save a copy of ThisWorkbook which your are working in, with a unique name everytime:


Dim fname As String, extn As String, MyStr As String
Dim i As Integer, lastDot As Integer

'change the current directory to the ThisWorkbook directory:
ChDir ThisWorkbook.Path

'find position of last dot, to distinguish file extension:
For i = 1 To Len(ThisWorkbook.Name)
If Mid(ThisWorkbook.Name, i, 1) = "." Then
lastDot = i
End If
Next i

'extract file extension and dot before extension:
extn = Right(ThisWorkbook.Name, Len(ThisWorkbook.Name) - lastDot + 1)
'extract workbook name excluding its name extension and dot before extension:
MyStr = Left(ThisWorkbook.Name, lastDot - 1)

'specify name for the copy - the time part in the file name will help in indentifying the last backup, besides making the name unique:
fname = MyStr & "__S_Ditchfield__" & Format(Now(), "dd-mm-yyyy ---- hh-mm AMPM") & extn


'save a copy of ThisWorkbook which your are working in, specifying a file name - use this method to save your existing work, while your current workbook remains the active workbook:
ThisWorkbook.SaveCopyAs fname



'your current workbook remains the active workbook, the saved copy remains closed:
MsgBox ActiveWorkbook.Name

End Sub


very much appreciated
regards
Ditchy

On Monday, May 12, 2014 5:29:43 PM UTC+10, wrote:
Hello,

I am trying to copy a sheet, saving as a new workbook, values & number formats

also with the filename taken from (A1) all with the click of a button, sounds easy!

here is the macro



Dim myFileName As String

With ActiveWorkbook

* *worksheets(1).Copy 'to a new workbook

* with active sheet with.UsedRange.

Copy.PasteSpecial Paste:=xlPasteValues 'remove formulas??? *

'pick up the name from some cells???

*myfilename = .range("a1").value & ".xls" myfilename = "C:\Users\Ditchy\Desktop\" & myfilename *'????

.Parent.SaveAs Filename:=myFileName, FileFormat:=xlWorkbookNormal

.Parent.Close savechanges:=False

End With

End Sub



any and all help appreciated



regards

Ditchy

Ballarat

Australia

[Claus Busch]

Hi Stephen,

Am Tue, 13 May 2014 00:45:59 -0700 (PDT) schrieb
:

Is there a way you could modify this one to copy and save as values and number formats in C:\Users\Ditchy\Desktop\. ?
This macro works but copies to desktop & does not save as values and number formats

try:

Sub WorkbookSaveCopyAs2()
'use the Workbook.SaveCopyAs Method to save a copy of ThisWorkbook which
your are working in, with a unique name everytime:

Dim fname As String, extn As String, MyStr As String
Dim lastDot As Integer

'find position of last dot, to distinguish file extension:
lastDot = InStrRev(ThisWorkbook.FullName, ".")

'extract file extension and dot before extension:
extn = Right(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) - lastDot
+ 1)
'extract workbook name excluding its name extension and dot before
extension:
MyStr = Left(ThisWorkbook.FullName, lastDot - 1)

'specify name for the copy - the time part in the file name will help in
indentifying the last backup, besides making the name unique:
fname = MyStr & "__S_Ditchfield__" & Format(Now(), "dd-mm-yyyy ----
hh-mm AMPM") & extn


'save a copy of ThisWorkbook which your are working in, specifying a
file name - use this method to save your existing work, while your
current workbook remains the active workbook:
ThisWorkbook.SaveCopyAs fname


'your current workbook remains the active workbook, the saved copy
remains closed:
MsgBox ActiveWorkbook.Name

End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

[GS[_2_]]

Here's how I handle this when time-stamping...

Sub SaveWkbAsCopy3()
Dim sUniqueName$, vFileInfo
Const sMyName$ = "_S.Ditchfield_" '//a fixed value?
vFileInfo = Split(ThisWorkbook.FullName, ".")

'Build timestamp (unique filename)
sUniqueName = Format(Now(), "dd-mm-yyyy----hh-mm-AMPM.") '//varies

'Save a copy with the new unique name appended
ThisWorkbook.SaveCopyAs Join(vFileInfo, sMyName & sUniqueName)
MsgBox ActiveWorkbook.name
End Sub

...where your personal stamp is held in a constant (which I shortened),
and the fullname of the file running the code is split into a 2 element
array using the dot as the delimiter. (vFileInfo(0) contains everything
left of the dot, vFileInfo(1) contains the file extension.

The timestamp is then created in the desired format. (Note that I
replaced " AMPM" with "-AMPM." so there's no spaces in the (long)
filename, and the trailing dot is included here!)

Finally, the array is re-assembled using your personal stamp and the
timestamp as the delimter, and passed as the filename arg for the
SaveCopyAs method.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

[[email protected]]

Thanks Garry
that worked a treat, is there any way to save the file as numbers & value formats only, and in a designated directory, eg "C:\Users\Ditchy\Work Related"

your help is much appreciated
regards
Ditchy


On Monday, May 12, 2014 5:29:43 PM UTC+10, wrote:
Hello,

I am trying to copy a sheet, saving as a new workbook, values & number formats

also with the filename taken from (A1) all with the click of a button, sounds easy!

here is the macro



Dim myFileName As String

With ActiveWorkbook

* *worksheets(1).Copy 'to a new workbook

* with active sheet with.UsedRange.

Copy.PasteSpecial Paste:=xlPasteValues 'remove formulas??? *

'pick up the name from some cells???

*myfilename = .range("a1").value & ".xls" myfilename = "C:\Users\Ditchy\Desktop\" & myfilename *'????

.Parent.SaveAs Filename:=myFileName, FileFormat:=xlWorkbookNormal

.Parent.Close savechanges:=False

End With

End Sub



any and all help appreciated



regards

Ditchy

Ballarat

Australia

[GS[_2_]]

is there any way to save the file as numbers & value formats only,
and in a designated directory, eg "C:\Users\Ditchy\Work Related"

Do you mean 'also' SaveCopyAs to here or 'instead of' SaveCopyAs to the
existing fullname path?

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

[GS[_2_]]

Here's my actual procedure that I made your sample from...

Sub TimeStampFile(Optional Wkb As Workbook, Optional sSavePath$)
' Saves a copy of Wkb with '-name-time' stamp
Dim sNameStamp$, vFileInfo

If Wkb Is Nothing Then Set Wkb = ActiveWorkbook
vFileInfo = Split(Wkb.FullName, ".")

If sSavePath < "" Then
If Right(sSavePath, 1) < "\" Then sSavePath = sSavePath & "\"
vFileInfo(0) = sSavePath
End If
sNameStamp = "-" & Environ("username") & "-"

Wkb.SaveCopyAs Join(vFileInfo, sNameStamp & Now())
End Sub

...which puts the login user in sNameStamp. Here's examples of how I
might use it...

Sub Test_TimeStampFile()
'To save a copy of ActiveWorkbook to its .Path
Call TimeStampFile

'To save a copy of ActiveWorkbook to a different path
Call TimeStampFile(, "C:\Users\Ditchy\Work Related\")

'To save a copy of a specified Workbook to its .Path
Call TimeStampFile(ThisWorkbook) '//or Workbooks("?.?")

'To save a copy of a specified Workbook to a different path
Call TimeStampFile(ThisWorkbook, "C:\Users\Ditchy\Work Related\")
End Sub

So in your case, if you want the file copied to 2 different locations
then you need to call TimeStampFile twice. In your case you could store
the path to your user profile folder in a constant for convenience...

In a declarations section of the/any standard module:

Public Const gsMyWorkDocs$ = "C:\Users\Ditchy\Work Related\"

...where you can replace my "gs" prefix with your own if you use such
naming convention for indicating [scope]datatype of your variables.
(The g represents 'global' scope, the s represents 'string' type)

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

[GS[_2_]]

I just ran my procedure for something I was working on and it 'clicked'
I forgot to mention/example that the sSavePath$ arg should include the
'root' filename, meaning no extension. The calling procedure assembles
this to the new path before passing it in. I deliberately made it this
way so I could rename files on the fly...

Original filename: MyFile.xls
Revised filename...

Dim vTmp
'...code
vTmp = Split(ActiveWorkbook.FullName, ".")
Call TimeStampFile(, vTmp(0) & "-Final")

...and the name/time stamp gets appended to the revised root filename.

I see I also didn't revise for your time stamp custom format.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

[[email protected]]

Hi Garry, I see it but I am confused, I know very little about vba.
It worked fine with the first one you did but I am unable to modify.
I need the file to save as a "numbers and value format" (I don't want the formulas to work, just raw data)
in a folder here
"C:\Work Related Data"
I just can't figure out how to alter your code.

thanks again
Ditchy
On Monday, May 12, 2014 5:29:43 PM UTC+10, wrote:
Hello,

I am trying to copy a sheet, saving as a new workbook, values & number formats

also with the filename taken from (A1) all with the click of a button, sounds easy!

here is the macro



Dim myFileName As String

With ActiveWorkbook

* *worksheets(1).Copy 'to a new workbook

* with active sheet with.UsedRange.

Copy.PasteSpecial Paste:=xlPasteValues 'remove formulas??? *

'pick up the name from some cells???

*myfilename = .range("a1").value & ".xls" myfilename = "C:\Users\Ditchy\Desktop\" & myfilename *'????

.Parent.SaveAs Filename:=myFileName, FileFormat:=xlWorkbookNormal

.Parent.Close savechanges:=False

End With

End Sub



any and all help appreciated



regards

Ditchy

Ballarat

Australia

[GS[_2_]]

Hi Garry, I see it but I am confused, I know very little about vba.
It worked fine with the first one you did but I am unable to modify.
I need the file to save as a "numbers and value format" (I don't want
the formulas to work, just raw data)
in a folder here
"C:\Work Related Data"
I just can't figure out how to alter your code.

Got it! I'll work on that after I finish rewriting my time stamp
procedure to include within all (if any) changes to the original path
and/or filename, SaveCopyAs, or just SaveAs.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

[GS[_2_]]

Okay, your need has spawned a redo of my timestamp procedure as
follows...

Sub TimeStampFile(Optional Wkb As Workbook, Optional SavePath$, _
Optional Filename$, Optional AddNameStamp As Boolean,
_
Optional SaveAsCopy As Boolean = True)
' Puts a date/time stamp on Wkb filename.
' Formats timestamp appropriate for use in filenames.
'
' ArgsIn:
' Wkb Ref to the workbook having its filename timestamped;
' If not specified then ref defaults to
ActiveWorkbook.
' SavePath Allows specifying a new path;
' If not specified Wkb.Path is used.
' Filename Allows renaming root filename;
' If not specified Wkb.Name is used.
' AddNameStamp True to put username between filename and timestamp;
' Default = False.
' SaveAsCopy Saves a copy of Wkb;
' Default=True;
' Note: This DOES NOT alter the original file.
' False saves Wkb as specified in 'SavePath' and/or
'Filename';
' Note: This DOES alter the original file.

Dim sFile$, sNameStamp$, vFileInfo

'Get a fully qualified ref to the workbook
If Wkb Is Nothing Then Set Wkb = ActiveWorkbook

'Parse the file extension
vFileInfo = Split(Wkb.FullName, ".")
vFileInfo(1) = "." & vFileInfo(1) '//restore dot to file ext.
sFile = vFileInfo(0)

If SavePath < "" Then
If Right(SavePath, 1) < "\" Then SavePath = SavePath & "\"
sFile = SavePath & Split(Wkb.Name, ".")(0)
End If 'SavePath < ""

If Filename < "" Then sFile = Replace(sFile, Split(Wkb.Name,
".")(0), Filename)
'Separate name from stamps so filename is easy to read
sFile = sFile & "_"

If AddNameStamp Then vFileInfo(0) = sFile & Environ("username") & "_"
'Separate timestamp parts so they're easy to read
sFile = Join(vFileInfo, Format(Now(), "dd-mm-yyyy_hh-mm_AMPM"))

'Creat the new file
If SaveAsCopy Then Wkb.SaveCopyAs sFile Else Wkb.SaveAs sFile
End Sub

...which is reusable in the following fashion...

Sub Test_TimeStampFile()
'To save a copy of ActiveWorkbook to its .Path
TimeStampFile

'To save a copy of ActiveWorkbook to a different path
TimeStampFile SavePath:="C:\Users\Ditchy\Work Related\"

'To save a copy of ActiveWorkbook to a different path,
'with a different root filename.
TimeStampFile SavePath:="C:\Users\Ditchy\Work Related\",
Filename:="NewName"

'To save a copy of ActiveWorkbook to a different path,
'with a namestamp.
TimeStampFile SavePath:="C:\Users\Ditchy\Work Related\",
AddNameStamp:=True

'To do same for a specified 'open' Workbook, add:
TimeStampFile Wkb:=ThisWorkbook
'Or
TimeStampFile Wkb:=Workbooks("MyFile.xls")
End Sub

This will handle your file save issues every which way you need it
done. It even saves to network locations if you specify a UNC path (ie:
"\\Server\Share")

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

[GS[_2_]]

Hi Garry, I see it but I am confused, I know very little about vba.
It worked fine with the first one you did but I am unable to modify.
I need the file to save as a "numbers and value format" (I don't want
the formulas to work, just raw data)
in a folder here
"C:\Work Related Data"

To convert formula results to constants will require copying sheets to
a new workbook, then convert the data, then save the file...

Sub ConvertToValues()
Dim wkbTarget As Workbook, wks, sFile$
Const sExt$ = ".xls" '//edit to suit

'Copy sheets to new workbook
ActiveWindow.SelectedSheets.Copy
Set wkbTarget = ActiveWorkbook

'Convert to values
For Each wks In wkbTarget.Worksheets
With wks.UsedRange: .Value = .Value: End With
Next 'wks

'At this point wkbTarget has not been saved,
'so SaveAs, timestamp a copy of it then close it.
sFile = "C:\Work Related Data\MyFilename" & sExt
With wkbTarget
.SaveAs sFile: TimeStampFile: .Close
End With

'Cleanup
Set wkbTarget = Nothing
Kill sFile '//if you don't need the unstamped file
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

[GS[_2_]]

<FWIW (a.k.a food for thought)

Not sure why you convert formula results to values, but typical reason
is for archiving. Another typical reason is for distribution where
formulas need to be protected.

If the original file gets reused as if it was a template, there's
better ways to handle this if you open the file 'as a template'. Doing
so will allow you to convert to values and use SaveAs, then close the
file normally without affecting the original file used 'as a template'
in any way.

Another way to archive raw data is to 'dump' sheet contents into a text
file. This takes up way less disk space and gives you just values. (no
formatting, though)

Ultimately, providing us with an overview of your project intent goes a
long way toward finding an optimum solution!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

[GS[_2_]]

Insert a new line as follows...

Sub TimeStampFile(Optional Wkb As Workbook, Optional SavePath$, _
Optional Filename$, Optional AddNameStamp As
Boolean, _
Optional SaveAsCopy As Boolean = True)
' Puts a date/time stamp on Wkb filename.
' Formats timestamp appropriate for use in filenames.
'
' ArgsIn:
' Wkb Ref to the workbook having its filename
timestamped;
' If not specified then ref defaults to
ActiveWorkbook.
' SavePath Allows specifying a new path;
' If not specified Wkb.Path is used.
' Filename Allows renaming root filename;
' If not specified Wkb.Name is used.
' AddNameStamp True to put username between filename and
timestamp;
' Default = False.
' SaveAsCopy Saves a copy of Wkb;
' Default=True;
' Note: This DOES NOT alter the original file.
' False saves Wkb as specified in 'SavePath' and/or
'Filename';
' Note: This DOES alter the original file.

Dim sFile$, sNameStamp$, vFileInfo

'Get a fully qualified ref to the workbook
If Wkb Is Nothing Then Set Wkb = ActiveWorkbook

'Parse the file extension
vFileInfo = Split(Wkb.FullName, ".")
If Not IsArray(vFileInfo) Then Beep: Exit Sub '//unsaved file

vFileInfo(1) = "." & vFileInfo(1) '//restore dot to file ext.
sFile = vFileInfo(0)

If SavePath < "" Then
If Right(SavePath, 1) < "\" Then SavePath = SavePath & "\"
sFile = SavePath & Split(Wkb.Name, ".")(0)
End If 'SavePath < ""

If Filename < "" Then sFile = Replace(sFile, Split(Wkb.Name,
".")(0), Filename)
'Separate name from stamps so filename is easy to read
sFile = sFile & "_"

If AddNameStamp Then vFileInfo(0) = sFile & Environ("username") &
"_"
'Separate timestamp parts so they're easy to read
sFile = Join(vFileInfo, Format(Now(), "dd-mm-yyyy_hh-mm_AMPM"))

'Creat the new file
If SaveAsCopy Then Wkb.SaveCopyAs sFile Else Wkb.SaveAs sFile
End Sub

..which is reusable in the following fashion...

Sub Test_TimeStampFile()
'To save a copy of ActiveWorkbook to its .Path
TimeStampFile

'To save a copy of ActiveWorkbook to a different path
TimeStampFile SavePath:="C:\Users\Ditchy\Work Related\"

'To save a copy of ActiveWorkbook to a different path,
'with a different root filename.
TimeStampFile SavePath:="C:\Users\Ditchy\Work Related\",
Filename:="NewName"

'To save a copy of ActiveWorkbook to a different path,
'with a namestamp.
TimeStampFile SavePath:="C:\Users\Ditchy\Work Related\",
AddNameStamp:=True

'To do same for a specified 'open' Workbook, add:
TimeStampFile Wkb:=ThisWorkbook
'Or
TimeStampFile Wkb:=Workbooks("MyFile.xls")
End Sub

This will handle your file save issues every which way you need it
done. It even saves to network locations if you specify a UNC path
(ie: "\\Server\Share")

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

[GS[_2_]]

Oops! Change this line...

If Not IsArray(vFileInfo) Then Beep: Exit Sub '//unsaved file

to this...

'Make sure we have a file extension
If LBound(vFileInfo) = UBound(vFileInfo) Then Beep: Exit Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

[GS[_2_]]

Okay.., I managed to get things tweaked so that the TimeStampFile
routine will also handle new unsaved files. The previously posted
'Test_' routine has been revised accordingly.

I invite any feedback...

Sub TimeStampFile(Optional Wkb As Workbook, Optional SavePath$, _
Optional Filename$, Optional AddNameStamp As Boolean,
_
Optional SaveAsCopy As Boolean = True)
' Puts a date/time stamp on Wkb filename.
' Formats timestamp appropriate for use in filenames.
'
' ArgsIn:
' Wkb Ref to the workbook having its filename timestamped;
' If not specified then ref defaults to
ActiveWorkbook.
' If Wkb is a new unsaved workbook then next 2 args
must be valid.
'
' SavePath Allows specifying a new path;
' If not specified Wkb.Path is used.
' Req'd if Wkb is a new unsaved workbook.
'
' Filename Allows renaming root filename;
' If not specified Wkb.Name is used.
' Req'd if Wkb is a new unsaved workbook.
'
' AddNameStamp True to put username between filename and timestamp;
' Default = False.
'
' SaveAsCopy True saves a copy of Wkb; (Default)
' Note: This DOES NOT alter the original file.
' False saves Wkb as specified in 'SavePath' and/or
'Filename';
' Note: This DOES alter the original file.

Dim sFile$, sNameStamp$, vFileInfo

'Get a fully qualified ref to the workbook
If Wkb Is Nothing Then Set Wkb = ActiveWorkbook

If SavePath < "" Then
If Right(SavePath, 1) < "\" Then SavePath = SavePath & "\"
End If 'SavePath < ""

'Make sure we have a file extension
vFileInfo = Split(Wkb.FullName, ".")
'If no file ext then it's an unsaved file,
'and so has no path yet.
If LBound(vFileInfo) = UBound(vFileInfo) Then
If SavePath < "" And Filename < "" Then
'Use the new file info
vFileInfo = Split(Filename, ".")
vFileInfo(0) = SavePath & vFileInfo(0)
vFileInfo(1) = "." & vFileInfo(1) '//restore dot to file ext.
sFile = vFileInfo(0): GoTo StampIt
Else '//abort
Beep
Exit Sub
End If
End If 'LBound=UBound

vFileInfo(1) = "." & vFileInfo(1) '//restore dot to file ext.
sFile = vFileInfo(0)

If SavePath < "" Then sFile = SavePath & Split(Wkb.Name, ".")(0)
If Filename < "" Then sFile = Replace(sFile, Split(Wkb.Name,
".")(0), Filename)

StampIt:
'Separate name from stamps so filename is easy to read
vFileInfo(0) = sFile & "_"
If AddNameStamp Then vFileInfo(0) = vFileInfo(0) &
Environ("username") & "_"
'Separate timestamp parts so they're easy to read
sFile = Join(vFileInfo, Format(Now(), "dd-mm-yyyy_hh-mm_AMPM"))

'Creat the new file
If SaveAsCopy Then Wkb.SaveCopyAs sFile Else Wkb.SaveAs sFile
End Sub

Sub Test_TimeStampFile()
'To save a copy of ActiveWorkbook to its .Path
TimeStampFile

'To save a copy of ActiveWorkbook to a different path
TimeStampFile SavePath:="C:\Users\Garry\Documents\VBA_Stuff"

'To save a copy of ActiveWorkbook to a different path,
'with a different filename.
'Note: This is the minimum requirement for a new unsaved workbook
TimeStampFile SavePath:="C:\Users\Garry\Documents\VBA_Stuff", _
Filename:="MyFile.xls"

'To save a copy of ActiveWorkbook to a different path,
'with a namestamp.
TimeStampFile SavePath:="C:\Users\Garry\Documents\VBA_Stuff", _
AddNameStamp:=True

'To do same for a specified 'open' Workbook, add:
TimeStampFile Wkb:=ThisWorkbook
'Or
TimeStampFile Wkb:=Workbooks("MyFile.xls")
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

[[email protected]]

Hi Garry,
I have managed to get this to work, but only with an unprotected sheet, when protected it comes up with a error (400) and saves it to the desktop with the name (book 6)not the workbook name. Is there a work around?
much appreciated
Ditchy

On Monday, May 12, 2014 5:29:43 PM UTC+10, wrote:
Hello,

I am trying to copy a sheet, saving as a new workbook, values & number formats

also with the filename taken from (A1) all with the click of a button, sounds easy!

here is the macro



Dim myFileName As String

With ActiveWorkbook

* *worksheets(1).Copy 'to a new workbook

* with active sheet with.UsedRange.

Copy.PasteSpecial Paste:=xlPasteValues 'remove formulas??? *

'pick up the name from some cells???

*myfilename = .range("a1").value & ".xls" myfilename = "C:\Users\Ditchy\Desktop\" & myfilename *'????

.Parent.SaveAs Filename:=myFileName, FileFormat:=xlWorkbookNormal

.Parent.Close savechanges:=False

End With

End Sub



any and all help appreciated



regards

Ditchy

Ballarat

Australia

[GS[_2_]]

I have managed to get this to work, but only with an unprotected
sheet, when protected it comes up with a error (400) and saves it to
the desktop with the name (book 6)not the workbook name. Is there a
work around?

When you set protection VBA code can't modify cells unless you specify
'UserInterfaceOnly=True' (non-persistent between sessions). You must do
this via code on unprotected sheets. That means the sheet protection
needs to be 'toggled' if existing, every time the file is opened.
Otherwise...

Sub ConvertToValues()
Dim wkbTarget As Workbook, wks, sFile$
Const sExt$ = ".xls" '//edit to suit

'Copy sheets to new workbook
ActiveWindow.SelectedSheets.Copy
Set wkbTarget = ActiveWorkbook

'Convert to values
For Each wks In wkbTarget.Worksheets
wks.Unprotect Password:=""
With wks.UsedRange: .Value = .Value: End With
wks.Protect Password:=""
Next 'wks

'At this point wkbTarget has not been saved,
'so timestamp a copy of it then close it.
TimeStampFile SavePath:="C:\Work Related Data", _
Filename:="MyFilename" & sExt
wkbTarget.Close SaveChanges:=False
'Cleanup
Set wkbTarget = Nothing
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

[GS[_2_]]

OR...

Sub ConvertToValues()
Dim wkbTarget As Workbook, wks, sFile$
Const sExt$ = ".xls" '//edit to suit

'Copy sheets to new workbook
ActiveWindow.SelectedSheets.Copy
Set wkbTarget = ActiveWorkbook

'Convert to values
For Each wks In wkbTarget.Worksheets
With wks
.Unprotect Password:=""
.UsedRange.Value = .UsedRange.Value
.Protect Password:=""
End With
Next 'wks

'At this point wkbTarget has not been saved,
'so timestamp a copy of it then close it.
TimeStampFile SavePath:="C:\Work Related Data", _
Filename:="MyFilename" & sExt
wkbTarget.Close SaveChanges:=False
'Cleanup
Set wkbTarget = Nothing
End Sub

Don't forget to put your actual password between the quotes!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

[[email protected]]

Hi Garry
that is fantastic,
worked like a charm and thank you for your time and knowledge with helping me.
It is very much appreciated and I am very slowly learning.

regards
Ditchy


On Monday, May 12, 2014 5:29:43 PM UTC+10, wrote:
Hello,

I am trying to copy a sheet, saving as a new workbook, values & number formats

also with the filename taken from (A1) all with the click of a button, sounds easy!

here is the macro



Dim myFileName As String

With ActiveWorkbook

* *worksheets(1).Copy 'to a new workbook

* with active sheet with.UsedRange.

Copy.PasteSpecial Paste:=xlPasteValues 'remove formulas??? *

'pick up the name from some cells???

*myfilename = .range("a1").value & ".xls" myfilename = "C:\Users\Ditchy\Desktop\" & myfilename *'????

.Parent.SaveAs Filename:=myFileName, FileFormat:=xlWorkbookNormal

.Parent.Close savechanges:=False

End With

End Sub



any and all help appreciated



regards

Ditchy

Ballarat

Australia

[GS[_2_]]

Hi Garry
that is fantastic,
worked like a charm and thank you for your time and knowledge with
helping me.
It is very much appreciated and I am very slowly learning.

That's great!
I appreciate the feedback...

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion