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

[Excel Fox]

I get 43 xlsb files as output

[jamilm]

Capture.JPG
i restarted and tried again. still get the same error. also the runtime error


do i need to add any reference from the object library?

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 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

I get 43 xlsb files as output

[jamilm]

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]

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]

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]

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?

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]

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

I've made a small modification. try this

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