problems getting this macro to work

  • Thread starter Thread starter stephen.ditchfield
  • Start date Start date
S

stephen.ditchfield

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
 
Hi Ditchy,

Am Mon, 12 May 2014 00:29:43 -0700 (PDT) schrieb
(e-mail address removed):
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
Click to expand...

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.
 
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
 
Hi Ditchy,

Am Mon, 12 May 2014 01:37:38 -0700 (PDT) schrieb
(e-mail address removed):
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
Click to expand...

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.
 
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 numberformats



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-mmAMPM") & 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
 
Hi Stephen,

Am Tue, 13 May 2014 00:45:59 -0700 (PDT) schrieb
(e-mail address removed):
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
Click to expand...

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.
 
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
 
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
 
is there any way to save the file as numbers & value formats only,
and in a designated directory, eg "C:\Users\Ditchy\Work Related"
Click to expand...

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
 
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
 
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
 
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
 
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.
Click to expand...

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
 
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
 
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"
Click to expand...

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
 
<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
 
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, ".")
Click to expand...
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")
Click to expand...

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
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
 
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
 
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 withthe name (book 6)not the workbook name. Is there a work around?
much appreciated
Ditchy
 
Back
Top