Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#3
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#4
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#5
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#6
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
FileFormat is 52 so you use the wrong name for the extension
Again not tested Remove FileFormat = ".xlsm" Try this (I add .xlsm to the code line) ActiveWorkbook.SaveAs Filename:=myPath & Filename & mySerial & ".xlsm" , FileFormat:=52 -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "cardfan3206" wrote in message ... 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 |
#7
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#8
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
I thought the same thing but am still having problems with it. Below is the
current code. Thanks for the help! 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("L13:L23") 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("k: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") myExt = ".xlsm" ActiveWorkbook.SaveAs Filename:=myPath & myFile & mySerial & FileFormat = 52 Range("H12").Select Workbooks.Close End Sub "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 |
#9
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
ActiveWorkbook.SaveAs Filename:=myPath & myFile & myExt, FileFormat:=52
(mySerial = "", so it's not adding too much to the string.) cardfan3206 wrote: I thought the same thing but am still having problems with it. Below is the current code. Thanks for the help! 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("L13:L23") 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("k: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") myExt = ".xlsm" ActiveWorkbook.SaveAs Filename:=myPath & myFile & mySerial & FileFormat = 52 Range("H12").Select Workbooks.Close End Sub "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 -- Dave Peterson |
#10
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#11
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#12
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
I am still getting a runtime error 1004 when the code hits the following line
..SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum The complete code is now listed below: 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("L13:L23") 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("k:v").Select Selection.EntireColumn.Hidden = True ChDir "G:\Compensation\Market Analysis Files\" '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 = "G:\Compensation\Market Analysis Files\" TempFileName = Sheets("Market Detail").Range("D9") & " - " & Sheets("Market Detail").Range("D8") & " - " & Format(Date, "MM-DD-YYYY") 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 "Ron de Bruin" wrote: 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 |
#13
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Run only my macro to test it
Copy/Paste in a normal module Alt F8 Select the macro Run -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "cardfan3206" wrote in message ... I am still getting a runtime error 1004 when the code hits the following line .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum The complete code is now listed below: 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("L13:L23") 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("k:v").Select Selection.EntireColumn.Hidden = True ChDir "G:\Compensation\Market Analysis Files\" '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 = "G:\Compensation\Market Analysis Files\" TempFileName = Sheets("Market Detail").Range("D9") & " - " & Sheets("Market Detail").Range("D8") & " - " & Format(Date, "MM-DD-YYYY") 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 "Ron de Bruin" wrote: 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 |
#14
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Check to see if that folder really exists.
And check to see if the filename is valid. Add this line before the .saveAs line. debug.print TempFilePath & TempFileName & FileExtStr Then look at the immediate window and see if there's something wrong with that path or filename. cardfan3206 wrote: I am still getting a runtime error 1004 when the code hits the following line .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum The complete code is now listed below: 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("L13:L23") 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("k:v").Select Selection.EntireColumn.Hidden = True ChDir "G:\Compensation\Market Analysis Files\" '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 = "G:\Compensation\Market Analysis Files\" TempFileName = Sheets("Market Detail").Range("D9") & " - " & Sheets("Market Detail").Range("D8") & " - " & Format(Date, "MM-DD-YYYY") 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 "Ron de Bruin" wrote: 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 -- Dave Peterson |
#15
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Your macro works fine so I must have a problem in another part of my code.
"Ron de Bruin" wrote: Run only my macro to test it Copy/Paste in a normal module Alt F8 Select the macro Run -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "cardfan3206" wrote in message ... I am still getting a runtime error 1004 when the code hits the following line .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum The complete code is now listed below: 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("L13:L23") 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("k:v").Select Selection.EntireColumn.Hidden = True ChDir "G:\Compensation\Market Analysis Files\" '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 = "G:\Compensation\Market Analysis Files\" TempFileName = Sheets("Market Detail").Range("D9") & " - " & Sheets("Market Detail").Range("D8") & " - " & Format(Date, "MM-DD-YYYY") 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 "Ron de Bruin" wrote: 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 |
#16
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
I see a lot of wrong things in you code
Do While Len(Dir(myPath & myFile & mySerial & myExt)) 0 mySerial = "(" & Val(Mid(mySerial, 2)) + 1 & ")" Loop Where is myExt ? ActiveWorkbook.SaveAs Filename:=myPath & Filename & mySerial & FileFormat Where is Filename ? Also dim everyting at the top of the macro -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "cardfan3206" wrote in message ... Your macro works fine so I must have a problem in another part of my code. "Ron de Bruin" wrote: Run only my macro to test it Copy/Paste in a normal module Alt F8 Select the macro Run -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "cardfan3206" wrote in message ... I am still getting a runtime error 1004 when the code hits the following line .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum The complete code is now listed below: 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("L13:L23") 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("k:v").Select Selection.EntireColumn.Hidden = True ChDir "G:\Compensation\Market Analysis Files\" '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 = "G:\Compensation\Market Analysis Files\" TempFileName = Sheets("Market Detail").Range("D9") & " - " & Sheets("Market Detail").Range("D8") & " - " & Format(Date, "MM-DD-YYYY") 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 "Ron de Bruin" wrote: 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 |
#17
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Thanks Guys. I have checked the network path and it is fine. I now have the
file saving to the correct directory without errors. I only have a couple additional questions for you. I want the file name to reference certain cells within the file and was using the following string that worked in other code modules but doesn't work in this current one. The string is: Filename= Sheets("Market Detail").Range("D9") & " - " & Sheets("Market Detail").Range("D8") & " - " & Format(Date, "MM-DD-YYYY") The only other question I have is how to change the code to save the entire workbook instead of just the active sheet. Any help you could provide would be greatly appreciated. The current version of the entire code module is listed below for reference: Sub CloseWorkbook() ' ' 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("L13:L23") 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("k:v").Select Selection.EntireColumn.Hidden = True ChDir "G:\Compensation\Market Analysis Files\" '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 = "G:\Compensation\Market Analysis Files\" & "\" 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 "Dave Peterson" wrote: Check to see if that folder really exists. And check to see if the filename is valid. Add this line before the .saveAs line. debug.print TempFilePath & TempFileName & FileExtStr Then look at the immediate window and see if there's something wrong with that path or filename. cardfan3206 wrote: I am still getting a runtime error 1004 when the code hits the following line .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum The complete code is now listed below: 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("L13:L23") 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("k:v").Select Selection.EntireColumn.Hidden = True ChDir "G:\Compensation\Market Analysis Files\" '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 = "G:\Compensation\Market Analysis Files\" TempFileName = Sheets("Market Detail").Range("D9") & " - " & Sheets("Market Detail").Range("D8") & " - " & Format(Date, "MM-DD-YYYY") 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 "Ron de Bruin" wrote: 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Run-time error 1004 Method SaveAS of object _Workbook failed | Excel Programming | |||
Urgent help Runtime error ‘1004’ Method ‘SaveAs’ of object’-Workbook’ failed ????? | Excel Programming | |||
error 1004 Method SaveAs of Workbook failed | Excel Programming | |||
runtime error '1004' object '_Global' failed | Excel Programming | |||
Error Excel: 1004 SaveAs method of Workbook class failed | Excel Programming |