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!

Thursday, December 7, 2017

Excel split data into multiple worksheets based on column

 Here VBA Code to split data into multiple worksheets based on selected column

If you have an excel sheet and want to split the data into individual multiple sheet based on column valued then the below code is best for you.


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

Sub parse_data()
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
vcol = 7  ''name of column on which basis you want to create saprate sheet
Set ws = Sheets("finalsheet")  ''name of your master sheet which need to compile
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:V1"  ''range of column which need to transfer into each individual sheet
titlerow = ws.Range(title).Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
For i = 2 To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
End If
ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
Sheets(myarr(i) & "").Columns.AutoFit
Next
ws.AutoFilterMode = False
ws.Activate
End Sub



=========================
now its time to run your code by pressing F5.
Done!



No comments:

Post a Comment