VBA Macro Saving In Wrong Format

[Headstotails]

Hello All,
I looked around for a solution to this but was unable to find anything. If someone could point me in the right direction it would be greatly appreciated. I am using the following that I found on VBA express to save one sheet of a workbook as a new workbook in .xls format while removing all forumlas and pasting only values. I am using excel 2010. The problem that I am having is that the newly created workbook does not seem to be in .xls. When I check the properties of the file it does read as .xls but when opening the file excel states 'the file you are trying to open is in a didderent fromat than specified by the file extension....'. This file is used to upload data to a third party website and the site is not recognizing the sheet. When I open the sheet and resave as an .xls it is recognized by the website. I am thinking maybe because this code was for an older version of excel I need to update it somehow. Thanks for your help,

Sub Spreadsheetexport()
Dim NewName As String
Dim nm As Name
Dim ws As Worksheet

If MsgBox("Copy specific sheets to a new workbook" & vbCr & _
"New sheets will be pasted as values, named ranges removed" _
, vbYesNo, "NewCopy") = vbNo Then Exit Sub

With Application
.ScreenUpdating = False

' Copy specific sheets
' *SET THE SHEET NAMES TO COPY BELOW*
' Array("Sheet Name", "Another sheet name", "And Another"))
' Sheet names go inside quotes, seperated by commas
On Error GoTo ErrCatcher
Sheets(Array("Schedule Import Spreadsheet")).Copy
On Error GoTo 0

' Paste sheets as values
' Remove External Links, Hperlinks and hard-code formulas
' Make sure A1 is selected on all sheets
For Each ws In ActiveWorkbook.Worksheets
ws.Cells.Copy
ws.[A1].PasteSpecial Paste:=xlValues
ws.Cells.Hyperlinks.Delete
Application.CutCopyMode = False
Cells(1, 1).Select
ws.Activate
Next ws
Cells(1, 1).Select

' Remove named ranges
For Each nm In ActiveWorkbook.Names
nm.Delete
Next nm

' Input box to name new file
NewName = InputBox("Please Name The WMS Upload Spreadsheet", "New Copy")

' Save it with the NewName and in the same directory as original
ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xls"
ActiveWorkbook.Close SaveChanges:=False

.ScreenUpdating = True
End With
Exit Sub

ErrCatcher:
MsgBox "Specified sheets do not exist within this workbook"
End Sub

 

[NeonRedSharpie]

SaveCopyAs will not let you change the fileformat.

So, you're going to have to make a copy of it and save that.

    ActiveWorkbook.Sheets.Copy
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & NewName & ".xls", FileFormat:=56
    ActiveWorkbook.Close

Or something along these lines.

 

[JoeMo]

Try changing this line:

ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xls"

to this:

ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xls", Fileformat:= 56

 

[Headstotails]

Worked like a charm. Thank you,

 

[Headstotails]

If I can ask one more question. In exporting this sheet it would be ideal if rows with a zero value in colum A were deleted in the exported sheet but remained in the origional. Do you have any suggestions?