About Me

My photo
India
Hey there, lovely people! I'm Hemant Menaria, and I'm passionate about programming. Having completed my MCA in 2011, I've delved into the world of coding with fervor. I believe in sharing knowledge, making complex concepts easy to grasp for everyone. JAVA, PHP, and ANDROID hold a special place in my heart, and I spend most of my time immersed in them. Currently, I'm deeply engaged in API/Webservice frameworks and crafting Hybrid mobile applications to enhance flexibility in the digital realm. If you ever find yourself stuck with a programming challenge, feel free to reach out to me at +91-8955499900 or drop me a line at hemantmenaria008@gmail.com. I'm always eager to help fellow enthusiasts navigate the intricacies of coding!

Wednesday, July 22, 2020

Export And Save Each Worksheet As Separate


Export And Save Each Worksheet As Separate New Workbook In Excel



Open Visual basic editor by pressing Alt+F11
On project window at left side => right click on project => insert=>Module.
now paste below code. 

Option Explicit

Sub SaveShtsAsBook()
    Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
    MyFilePath$ = ActiveWorkbook.Path & "\" & _
    Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
         '      End With
        On Error Resume Next '<< a folder exists
        MkDir MyFilePath '<< create a folder
        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
                 'save book in this folder
                .SaveAs Filename:=MyFilePath _
                & "\" & SheetName & ".xls"
                .Close SaveChanges:=True
            End With
            .CutCopyMode = False
        Next
    End With
    Sheet1.Activate
End Sub



No comments:

Post a Comment