VBA code to copy sheet and save as xls format

[mira2020]

Hi all,

How to write a VBA code to copy 2 sheets of my current file (xlsm format) to a new workbook and change format of new workbook is xls ?
Currently, I use copy function and move 2 sheets to a new workbook and the new file format is xlsx.

thanks,

 

[Joe4]

Have you tried turning on your Macro Recorder and recording yourself performing these steps manually?
This should give you most of the VBA code you require.

 

[mira2020]

yes, the code looks like this

Sub Macro7()
Sheets("Tesst").Select
Sheets("Tesst").Copy
ChDir "C:\Users\XXXXX\Downloads"
ActiveWorkbook.SaveAs Filename:="C:\Users\XXXXX\Downloads\Book33.xls" _
, FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

However, everytime i run the macro, the name of the file will change to Book34, Book35....
and how to change the location that matching the user C drive. Now the XXXXX will refer to my name. but if it run on other user computer, it should change accordingly

 

[Joe4]

Assuming that:
- we can use Environ("UserName") to get the name of the current user and use that for the folder name
- we can look in the Downloads folder for the last file created started with the word "Book" to get the last number used

We can "borrow" the code found here: Finding Last Created / Most Recent File with VBA not referencing Microsoft Scripting Runtime (The Answer)
to come up with this code for you:

Sub Macro7()

Dim usr As String
Dim dr As String
Dim fl As String
Dim tmp As String
Dim nm As Long

'Get current user name
usr = Environ("UserName")

'Set directory
dr = "C:\Users\" & usr & "\Downloads"

'Get most recent file starting with "Book" and ending with "xls" in folder
fl = mostRecentFile(dr)

'Get next file number in line
tmp = Mid(fl, 5)
tmp = Left(tmp, Len(tmp) - 4)
nm = tmp + 1

'Save file with new name
Sheets("Tesst").Select
Sheets("Tesst").Copy
ChDir dr
ActiveWorkbook.SaveAs Filename:=dr & "\Book" & nm & ".xls" _
    , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False

End Sub


Function mostRecentFile(strFolderPath As String)
    
    Dim fileSystem As Object: Set fileSystem = CreateObject("Scripting.FileSystemObject")
    Dim folder As Object: Set folder = fileSystem.GetFolder(strFolderPath)
    Dim file As Object
    
    Dim strFileName As String
    Dim fileDate As Date
    
    'Loop through all files in directory
    For Each file In folder.Files
        
        'Find newest file that starts with "Book" and ends with "xls"
        If (file.DateCreated > fileDate) And (Left(file.Name, 4) = "Book") And (Right(file.Name, 3) = "xls") Then
            fileDate = file.DateCreated
            strFileName = file.Name
        End If
    Next file
    'Displays last created file name
    mostRecentFile = strFileName
    
End Function

 

[mira2020]

umm. I got this error

 

[mira2020]

Can i change the file extension without saving the file somewhere?

thanks

 

[Joe4]

umm. I got this error
View attachment 99582

It looks like you are logged in as the Admin, and not with a user account.
If that is case, I am not sure how you can get the name of the user to automatically know which user drive to save the file to.

Can i change the file extension without saving the file somewhere?

I don't know that makes any sense.
If you are not saving the file, what are you trying to do with it?
And what would be the point of trying to change the extension if you aren't saving it?