Export all sheets as XLSX

[Nando1988]

I want to export all sheets as xlsx with vba, and save that macro in the personal workbook.
I searched online for some code and then I modified it, so that I could select the folder in which I want to save the sheets in, and it works, but only if the macro is saved in the workbook I am working on, but it no longer works, if I save it in the personal workbook.
This is the code I have:

Sub SplitWorkbook()
'Updateby20140612
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim xWs As Worksheet
Dim xWb As Workbook
Dim FolderName As String
Dim selectedfolder As String
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show() = -1 Then
        selectedfolder = .SelectedItems(1)
        Application.ScreenUpdating = False
        Set xWb = Application.ThisWorkbook
        DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
        FolderName = selectedfolder & "\" & xWb.Name & " " & DateString
        MkDir FolderName
        For Each xWs In xWb.Worksheets
            xWs.Copy
            If Val(Application.Version) < 12 Then
                FileExtStr = ".xls": FileFormatNum = -4143
            Else
                Select Case xWb.FileFormat
                    Case 51:
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    Case 52:
                        If Application.ActiveWorkbook.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
            xFile = FolderName & "\" & Application.ActiveWorkbook.Sheets(1).Name & FileExtStr
            Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum
            Application.ActiveWorkbook.Close False
        Next
        MsgBox "You can find the files in " & FolderName
        Application.ScreenUpdating = True
Else
End If
End With
End Sub

Any help to fix the issue with this macro and the personal workbook will be greatly appreciated.
Thanks in advance.

 

[James006]

Hello,

You can test following modification

Set xWb = ActiveWorkbook

Hope this will help

 

[nando88]

That's exactly what I needed.
You're the best.
Thanks.

 

[James006]

You are welcome