10$ For VBA Code Split Data To Multiple Workbook Based On Unique Values In A Column

**jamilm** · 05-22-2013, 11:03 PM

i found the problem. it is becuase the source workbook file format is .xlsb and once i changed it to .xls then it worked.

all of my source workbooks are originally xlsb is there anyway that the code will work in xlsb source workbook?

**jamilm** · 05-22-2013, 11:06 PM

i also checked with other file formats it does not work in xlsm as well. it only works in .xls seems like the code only functions in old version of excel only.

**Excel Fox** · 05-22-2013, 11:14 PM

IT's working fine for me in the binary format (xlsb).

I've made a small modification. try this

Code:

Sub SplitWorkbook()

    Dim colLetter As String, SavePath As String
    Dim lastValue As String
    Dim wb As Workbook
    Dim lng As Long
    Dim currentRow As Long
    colLetter = "P"
    SavePath = "" 'Indicate the path to save
    If SavePath = "" Then SavePath = ThisWorkbook.Path
    'Sort the workbook.
    With ThisWorkbook.Worksheets(1)
        .Sort.SortFields.Add Key:=.Range(colLetter & ":" & colLetter), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange .Parent.UsedRange.Cells
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        For lng = 2 To .Range(colLetter & .Rows.Count).End(xlUp).Row
            If .Cells(lng, colLetter).Value = "" Then Exit For
            lastValue = .Cells(lng, colLetter).Value
            .Cells.AutoFilter field:=.Cells(lng, colLetter).Column, Criteria1:=lastValue
            lng = .Cells(.Rows.Count, colLetter).End(xlUp).Row
            Set wb = Application.Workbooks.Add(xlWorksheet)
            .Rows(1 & ":" & lng).Copy wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp)
            wb.SaveAs SavePath & "\" & lastValue, 50
            wb.Close
        Next
        .AutoFilterMode = False
    End With
    
End Sub

**jamilm** · 05-22-2013, 11:27 PM

**Excel Fox** · 05-22-2013, 11:35 PM

It's more to do with your available system resources, than anything else I think. Can you try the same macro on a more powerful computer?

**jamilm** · 05-22-2013, 11:38 PM

the modified code you provided, worked perfectly.

now only one issue that all the generated workbooks have the default worksheet name as "sheet1" i want the worksheet name to be the same as the source worksheet which is "GL_Details" for all those generated workbooks the worksheet name should be "GL_Details"

can you please help on this part of the code?

Originally Posted by Excel Fox

It's more to do with your available system resources, than anything else I think. Can you try the same macro on a more powerful computer?

**Excel Fox** · 05-22-2013, 11:46 PM

The reason why the modified code worked is because I reduced the range of cells to just the used range of the sheet. So it's your available resources that's cause the trouble. Having said that, I should have only used the used range instead of the entire cells.

To add a name to the sheet, just add the below line, right after the workbook is added

Code:

wb.Sheets(1).Name = "NameOfSheetHere"

**jamilm** · 05-22-2013, 11:58 PM

thank you very much. i do not even know your name. but i i guess that our messages have crossed before in mrexcel forums.

so, please give pm me your paypal ID so that i send you 10 bucks.

also looking forward for solution to my outlook project in the other thread.

Originally Posted by Excel Fox

The reason why the modified code worked is because I reduced the range of cells to just the used range of the sheet. So it's your available resources that's cause the trouble. Having said that, I should have only used the used range instead of the entire cells.

To add a name to the sheet, just add the below line, right after the workbook is added

Code: