Do you get a error if you use this macro from my page

Sub Copy_ActiveSheet_1()
'Working in Excel 97-2007
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

'Copy the sheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
'We exit the sub when your answer is NO in the security dialog that you
'only see when you copy a sheet from a xlsm file with macro's disabled.
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With

' 'Change all cells in the worksheet to values if you want
' With Destwb.Sheets(1).UsedRange
' .Cells.Copy
' .Cells.PasteSpecial xlPasteValues
' .Cells(1).Select
' End With
' Application.CutCopyMode = False

'Save the new workbook and close it
TempFilePath = Application.DefaultFilePath & "\"
TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "yyyy-mm-dd hh-mm-ss")

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
.Close SaveChanges:=False
End With

MsgBox "You can find the new file in " & TempFilePath

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm




"cardfan3206" wrote in message ...
Thanks for te help Dave. I am now back to getting the runtime error 1004
that I was originally getting so I am not sure what else I can do to get this
to work.

"Dave Peterson" wrote:

I'm guessing you had a typo--you dropped the : from the filename:=mypath & ...

If that doesn't help, you should post your current code.

cardfan3206 wrote:

Thanks Ron. The code now executes but it is naming the file "False" instead
of the defined parameters in the code. Any ideas on this last issue?

"Ron de Bruin" wrote:

Untested in your code but try this

ActiveWorkbook.SaveAs Filename:=myPath & Filename & mySerial & FileFormat , 52


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm




"cardfan3206" wrote in message
...
Thanks Ron. To be quite honest, I just started learning about using vba to
execute routine things a couple weeks ago and although I tried to use the
site you gave me to solve my issue, I still don't seem to be able to figure
it out. Is there any other way to tell what is wrong with the save as
statement?

"Ron de Bruin" wrote:

See this page about your problem
http://www.rondebruin.nl/saveas.htm



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm




"cardfan3206" wrote in message
...
I have the following code and am getting a saveas workbook failed error when
I reach the Activeworkbook.Saveas line of the code. I haven't changed the
code since last week and it worked then so I am not sure why I am getting
this error now. If anyone has any ideas what could be wrong I would
appreciate it.

Thanks!

Sub WorkbookClose()
'
' WorkbookClose Macro
' Formats file for printing and saves to directory
'
'

' Hides Rows that are empty
'
Dim rangeToTest As Range
Dim anyCell As Object

Set rangeToTest = Range("K13:K23")
For Each anyCell In rangeToTest
If IsEmpty(anyCell) Then
anyCell.EntireRow.Hidden = True
End If
Next

'Hides columns containing raw/unadjusted data

Columns("A:B").Select
Selection.EntireColumn.Hidden = True
Columns("J:V").Select
Selection.EntireColumn.Hidden = True
ChDir "G:\Compensation\Market Analysis Files\"


mySerial = ""
myPath = "G:\Compensation\Market Analysis Files\"
myFile = Sheets("Market Detail").Range("D9") & " - " & Sheets("Market
Detail").Range("D8") & " - " & Format(Date, "MM-DD-YYYY")
FileFormat = ".xlsm"

' create output using sequence 1 to n if file already exists
If Len(Dir(myPath & myFile & mySerial & myExt)) 0 Then

Do While Len(Dir(myPath & myFile & mySerial & myExt)) 0
mySerial = "(" & Val(Mid(mySerial, 2)) + 1 & ")"
Loop

End If

ActiveWorkbook.SaveAs Filename:=myPath & Filename & mySerial & FileFormat

Range("H12").Select
ThisWorkbook.Close
End Sub





--

Dave Peterson