Excel VBA Create New Folder & Copy Sheets To It

Excel VBA Create New Folder & Copy Sheets Of Workbook To It

       📁 A new folder with the same name as the workbook (if folder does not exist) is created at the same place with workbook.

The workbook's sheets as new workbooks are copied into this folder.

🔧 Our codes that we used in macro:

Sub createfolder()
Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&

Application.ScreenUpdating = False
MyFilePath$ = ActiveWorkbook.Path & "\" & _
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)

With Application
.ScreenUpdating = False
.DisplayAlerts = False

On Error Resume Next
MkDir MyFilePath
For N = 1 To Sheets.Count
Sheets(N).Activate
SheetName = ActiveSheet.Name
Cells.Copy
Workbooks.Add (xlWBATWorksheet)
With ActiveWorkbook
With .ActiveSheet
.Paste
.Name = SheetName
[A1].Select
End With
.SaveAs Filename:=MyFilePath _
& "\" & SheetName & ".xlsx"
.Close SaveChanges:=True
End With
.CutCopyMode = False
Next
End With
Sheets(1).Activate
Application.ScreenUpdating = True

MsgBox "The Process Was Carried Out Successfully", vbInformation
End Sub

All processes with a button click.