How can fix my split the worksheet by column--the lastRow value keep unchanged(0)?

luofeiyu1 · September 11, 2025, 9:59am

I want to split the worksheet by column C:
sample.ods (9.2 KB)

Sub SplitByColumn
    GlobalScope.BasicLibraries.loadLibrary("ScriptForge")
    Dim oDict As Variant
    oDict = CreateScriptService("Dictionary")
    Dim oDoc As Object
    Dim oSheets As Object
    Dim sourceSheet As Object
    Dim targetSheet As Object
    Dim sourceCell As Object
    Dim oCurs As Object
    Dim tSheetName As String
    Dim targetRange As Object    
    Dim sourceRange As Object
    Dim sColToSplit As String    
    oDoc = ThisComponent
    oSheets = oDoc.Sheets
    sourceSheet = oDoc.CurrentController.ActiveSheet
    oCurs = sourceSheet.createCursor()
    oCurs.gotoEndOfUsedArea(True)
    sourceRange = sourceSheet.getCellRangeByName(oCurs.AbsoluteName)
    lLastRow = sourceRange.RangeAddress.EndRow
    cLastCol = sourceRange.RangeAddress.EndColumn
    sColToSplit = InputBox("Enter the column letter to split by (e.g., 'B'):")
    For lRow = 2 To lLastRow
        sourceCell = sourceSheet.getCellRangeByName(sColToSplit & lRow)
        tSheetName = sourceCell.String
        If Not oDict.Exists(tSheetName) Then
            oSheets.insertNewByName(tSheetName,oSheets.count)
            targetSheet = oSheets.getByName(tSheetName)
            sourceRange = sourceSheet.getCellRangeByPosition(0, 0 , cLastCol-1,0)  
            targetRange = targetSheet.getCellRangeByPosition(0, 0 , cLastCol-1,0 ) 
            arr = sourceRange.getDataArray()
            targetRange.setDataArray(arr) 
            oDict.add  tSheetName,True
            oCurs = targetSheet.createCursor()
            oCurs.gotoEndOfUsedArea(True)
        End If
        targetSheet = oSheets.getByName(tSheetName)
        oCurs = targetSheet.createCursor()
        oCurs.gotoEndOfUsedArea(True)
        lastRow = oCurs.RangeAddress.EndRow          
        sourceRange = sourceSheet.getCellRangeByPosition(0, lRow-1, cLastCol-1,lRow-1)  
        targetRange = targetSheet.getCellRangeByPosition(0, lastRow , cLastCol-1,lastRow ) 
        arr = sourceRange.getDataArray()
        targetRange.setDataArray(arr)
        oCurs.gotoEndOfUsedArea(True)
        lastRow = oCurs.RangeAddress.EndRow 
    Next lRow    
End Sub

After execute the macro, “c1” worksheet contain only line ,same as “c2” worksheet.
3 x3 c1 y

I find that lastRow binded with targetSheet keep unchanged even the targetSheet is inserted new line in it.
Cause lastRow in targetSheet keeps 0 ,the already written head line by

    sourceRange = sourceSheet.getCellRangeByPosition(0, 0 , cLastCol-1,0)  
    targetRange = targetSheet.getCellRangeByPosition(0, 0 , cLastCol-1,0 ) 
    arr = sourceRange.getDataArray()
    targetRange.setDataArray(arr)

were be override by the later setDataArray.
How can fix the macro?

JohnSUN · September 11, 2025, 2:46pm

Well, the attempt to get the first empty row below the table should not be lastRow = oCurs.RangeAddress.EndRow but lastRow = oCurs.RangeAddress.EndRow + 1.
But this is not the only logical error in your macro. For example, before creating a sheet, you do not check whether there is already a sheet with this name, so re-running the macro will result in an error. And - this is just my humble opinion - you are in vain trying to use ScriptForge mechanisms for such a simple task, you could have done the same thing yourself, without involving anything from the outside. For example, like this - sample split the worksheet by column.ods (15.6 KB)

luofeiyu1 · September 13, 2025, 2:11am

Sub SplitByColumn
    GlobalScope.BasicLibraries.loadLibrary("ScriptForge")
    Dim oDict As Variant
    oDict = CreateScriptService("Dictionary")
    Dim oDesk As Object
    Dim oDoc As Object
    Dim sURL As String

    sourceSheet = ThisComponent.CurrentController.ActiveSheet
    ThisComponent.LockControllers()
    oCurs = sourceSheet.createCursor()
    oCurs.gotoEndOfUsedArea(True)
    oRange = sourceSheet.getCellRangeByName(oCurs.AbsoluteName)
    lLastRow = oRange.RangeAddress.EndRow
    cLastCol = oRange.RangeAddress.EndColumn
    sColToSplit = InputBox("Enter the column letter to split by (e.g., 'B'):")

    For lRow = 2 To lLastRow
        oCell = sourceSheet.getCellRangeByName(sColToSplit & lRow)
        fnValue = oCell.String
        If Not oDict.Exists(fnValue) Then
            oDict.Add fnValue, True
        End If
    Next lRow
    Dim arr as variant
    Dim oFileAccess As Object
    oFileAccess = createUnoService("com.sun.star.ucb.SimpleFileAccess")
    Dim oTargetRange as object
    Dim oSourceRange as object

    oDesk = StarDesktop
    sURL = "private:factory/scalc"

    Dim dFilePath As String

    For Each fnValue In oDict.Keys
        oDoc = oDesk.loadComponentFromURL(sURL, "_blank", 0, Array())
        oDoc.LockControllers()
        targetSheet = oDoc.getSheets().getByName("Sheet1")
        dFilePath = ConvertToURL(fnValue & ".ods" )
           oTargetRange = targetSheet.getCellRangeByPosition(0, 0 , cLastCol, 0 )
           oSourceRange = sourceSheet.getCellRangeByPosition(0, 0 , cLastCol, 0 )
           arr = oSourceRange.getDataArray()
           oTargetRange.setDataArray(arr)
           targetContentRowStart = 1
           for idRow =2 to lLastRow
               if sourceSheet.getCellRangeByName(sColToSplit & CStr(idRow)).string = fnValue then
                   oTargetRange = targetSheet.getCellRangeByPosition(0, targetContentRowStart, cLastCol, targetContentRowStart)
                   oSourceRange = sourceSheet.getCellRangeByPosition(0, idRow-1, cLastCol, idRow-1)
                   arr = oSourceRange.getDataArray()
                   oTargetRange.setDataArray(arr)
                   targetContentRowStart = targetContentRowStart + 1
               end if
           next idRow
           oDoc.storeAsURL(dFilePath, Array())
         oDoc.close(True)
    Next fnValue
end sub

Write data into new workbook instead of new worksheet .