Modify the code to save files in xlsx format

[sofas]

Hello, I want to modify the code so that files are saved in xlsx format in the same directory path

Sub Worksheets_to_txt()                               '<--Saves each worksheet as a text file with the same name
    
    Dim WB As Workbook
    Dim WS As Worksheet
    Dim FileSavePathName As String
    Dim answer As VbMsgBoxResult
    Dim DoExport As Boolean
    
    Set WB = ActiveWorkbook
    
    answer = MsgBox("Are you sure you want to export worksheets?", vbYesNo, "Run Macro") '<--Pop up box to confirm export
    
    If answer = vbYes Then
        
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        
        For Each WS In WB.Worksheets
            Select Case WS.Name
                Case "Sheet1", "Sheet2", "Sheet4"         'list worksheets to export here
                    FileSavePathName = WB.Path & "\" & WS.Name & "_" & VBA.Format(Date, "YYYYMMDD") & ".txt"
                    DoExport = True
                    
                    'Msgbox code can be removed later if desired
                    Select Case MsgBox("Export worksheet?" & vbCr & vbCr & FileSavePathName, vbYesNoCancel Or vbQuestion, "Text File Export")
                        Case vbYes
                            DoExport = True
                        Case vbNo
                            DoExport = False
                        Case vbCancel
                            Exit Sub
                    End Select
                    
                    If DoExport Then
                        WS.Copy                           'make temporary workbook
                        With ActiveWorkbook
                            .SaveAs Filename:=FileSavePathName, FileFormat:=xlText, CreateBackup:=False 'export as textfile.
                            DoEvents
                            .Close False                  'close temporary workbook
                        End With
                    End If
            End Select
        Next WS
    End If
End Sub

 

[rlv01]

Hello, I want to modify the code so that files are saved in xlsx format in the same directory path

Right now your code saves to a .txt file. Do you mean you want to change that so that it save to .xlsx instead?

 

[sofas]

Yes, I want to save it
In xlsx format

Right now your code saves to a .txt file. Do you mean you want to change that so that it save to .xlsx instead?

 

[rlv01]

Perhaps something like this. Not tested.

Sub Worksheets_to_xlxs()                               '<--Saves each worksheet as a xlsx file with the same name
    
    Dim WB As Workbook
    Dim WS As Worksheet
    Dim FileSavePathName As String
    Dim answer As VbMsgBoxResult
    Dim DoExport As Boolean
    
    Set WB = ActiveWorkbook
    
    answer = MsgBox("Are you sure you want to export worksheets?", vbYesNo, "Run Macro") '<--Pop up box to confirm export
    
    If answer = vbYes Then
        
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        
        For Each WS In WB.Worksheets
            Select Case WS.Name
                Case "Sheet1", "Sheet2", "Sheet4"         'list worksheets to export here
                    FileSavePathName = WB.Path & "\" & WS.Name & "_" & VBA.Format(Date, "YYYYMMDD") & ".xlsx"  '".txt"
                    DoExport = True
                    
                    'Msgbox code can be removed later if desired
                    Select Case MsgBox("Export worksheet?" & vbCr & vbCr & FileSavePathName, vbYesNoCancel Or vbQuestion, "Worksheet Export") '"Text File Export")
                        Case vbYes
                            DoExport = True
                        Case vbNo
                            DoExport = False
                        Case vbCancel
                            Exit Sub
                    End Select
                    
                    If DoExport Then
                        WS.Copy                           'make temporary workbook
                        With ActiveWorkbook
                            '.SaveAs Filename:=FileSavePathName, FileFormat:=xlText, CreateBackup:=False 'export as textfile.
                            .SaveAs Filename:=FileSavePathName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False 'export as .xlsx
                            DoEvents
                            .Close False                  'close temporary workbook
                        End With
                    End If
            End Select
        Next WS
    End If
End Sub

 

[sofas]

Perhaps something like this. Not tested.

Sub Worksheets_to_xlxs()                               '<--Saves each worksheet as a xlsx file with the same name
   
    Dim WB As Workbook
    Dim WS As Worksheet
    Dim FileSavePathName As String
    Dim answer As VbMsgBoxResult
    Dim DoExport As Boolean
   
    Set WB = ActiveWorkbook
   
    answer = MsgBox("Are you sure you want to export worksheets?", vbYesNo, "Run Macro") '<--Pop up box to confirm export
   
    If answer = vbYes Then
       
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
       
        For Each WS In WB.Worksheets
            Select Case WS.Name
                Case "Sheet1", "Sheet2", "Sheet4"         'list worksheets to export here
                    FileSavePathName = WB.Path & "\" & WS.Name & "_" & VBA.Format(Date, "YYYYMMDD") & ".xlsx"  '".txt"
                    DoExport = True
                   
                    'Msgbox code can be removed later if desired
                    Select Case MsgBox("Export worksheet?" & vbCr & vbCr & FileSavePathName, vbYesNoCancel Or vbQuestion, "Worksheet Export") '"Text File Export")
                        Case vbYes
                            DoExport = True
                        Case vbNo
                            DoExport = False
                        Case vbCancel
                            Exit Sub
                    End Select
                   
                    If DoExport Then
                        WS.Copy                           'make temporary workbook
                        With ActiveWorkbook
                            '.SaveAs Filename:=FileSavePathName, FileFormat:=xlText, CreateBackup:=False 'export as textfile.
                            .SaveAs Filename:=FileSavePathName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False 'export as .xlsx
                            DoEvents
                            .Close False                  'close temporary workbook
                        End With
                    End If
            End Select
        Next WS
    End If
End Sub

Thank you. he is working well