We will be migrating from Ask to Discourse on the first week of August, read the details here

Ask Your Question

Calc - Copy merged cells when adding new rows [closed]

asked 2016-08-27 17:43:28 +0200

miketurn gravatar image

updated 2016-08-27 17:44:03 +0200

Hello Everyone,

Lets say you have a spreadsheet.

Rows 1-10 each have Columns A, B and C merged together.

Now say you want to add a new row between Row 4 and 5.

When you select Row 5 it highlights the Row 5 going from Column A, B and C.

Now when you use your trusty "Insert Rows Above" tool it creates a new row.

Problem is this new row no longer has Columns A, B and C merged together.

Does anyone know of any settings that could allow Calc to copy the merged properties of the cells selected when inserting new rows between them?

Thank You

edit retag flag offensive reopen merge delete

Closed for the following reason the question is answered, right answer was accepted by Alex Kemp
close date 2020-09-11 10:02:48.791962

2 Answers

Sort by » oldest newest most voted

answered 2016-08-28 07:12:54 +0200

pierre-yves samyn gravatar image


May be a workaround: we can get the desired result by the Paste SpecialSelection: FormatsShift Cells:Down (must already have copied the line first of course)


edit flag offensive delete link more

answered 2016-08-28 20:22:54 +0200

mark_t gravatar image

updated 2016-08-29 08:20:07 +0200

pierre-yves samyn gravatar image

The insert range and copy paste special can be automated using the following macro. This could be assigned to a hot key.

Select the range to insert, run InsertFormatRange, this will insert the range and copy paste formats and cell merge from the top row of your original selection.

REM  *****  BASIC  *****

Option Explicit

Sub InsertFormatRange

    Dim oCurSelection As Object

    oCurSelection = thisComponent.CurrentSelection

    oCurSelection.Spreadsheet.insertCells(oCurSelection.RangeAddress, com.sun.star.sheet.CellInsertMode.DOWN)

End Sub

Sub FormatRange
'   Format selected Range to match the row above the selection '

    Dim oCurSelection As Object
    Dim oController As Object
    Dim oSelRangeAddress As New com.sun.star.table.CellRangeAddress
    Dim oRefRangeAddress As New com.sun.star.table.CellRangeAddress
    Dim sSelAbsoluteName As String
    Dim sRefAbsoluteName As String

    oCurSelection = thisComponent.CurrentSelection
    sSelAbsoluteName = oCurSelection.AbsoluteName
    oSelRangeAddress = oCurSelection.RangeAddress

    If oSelRangeAddress.StartRow < 1 Then
        msgbox  "There is no row above the selection to copy formats."
        Exit Sub
    End If

    oRefRangeAddress = oSelRangeAddress
    oRefRangeAddress.StartRow = oSelRangeAddress.StartRow - 1
    oRefRangeAddress.EndRow = oSelRangeAddress.StartRow - 1

    sRefAbsoluteName = CellAddressString(oRefRangeAddress)

    '   Now use dispatch to copy and paste special '

    rem ----------------------------------------------------------------------
    rem define variables
    dim document   as object
    dim dispatcher as object
    rem ----------------------------------------------------------------------
    rem get access to the document
    document   = ThisComponent.CurrentController.Frame
    dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

    rem ----------------------------------------------------------------------
    dim args1(0) as new com.sun.star.beans.PropertyValue
    args1(0).Name = "ToPoint"
    args1(0).Value = sRefAbsoluteName

    dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())

    rem ----------------------------------------------------------------------
    dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())

    rem ----------------------------------------------------------------------
    dim args3(0) as new com.sun.star.beans.PropertyValue
    args3(0).Name = "ToPoint"
    args3(0).Value = sSelAbsoluteName

    dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args3())

    rem ----------------------------------------------------------------------
    dim args4(5) as new com.sun.star.beans.PropertyValue
    args4(0).Name = "Flags"
    args4(0).Value = "T"
    args4(1).Name = "FormulaCommand"
    args4(1).Value = 0
    args4(2).Name = "SkipEmptyCells"
    args4(2).Value = false
    args4(3).Name = "Transpose"
    args4(3).Value = false
    args4(4).Name = "AsLink"
    args4(4).Value = false
    args4(5).Name = "MoveMode"
    args4(5).Value = 6

    dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args4())
End Sub

Function CellAddressString(oCellAddr as Object) as String

    Dim FuncService As Object

    '   Create service to access sheet functions '
    FuncService = createunoservice("com.sun.star.sheet.FunctionAccess")

    CellAddressString = FuncService.CallFunction("ADDRESS", _
                                            array(oCellAddr.StartRow+1, _

    If oCellAddr.EndRow > oCellAddr.StartRow Or oCellAddr.EndColumn > oCellAddr.StartColumn Then
        CellAddressString = CellAddressString _
                            & ":" & FuncService.CallFunction("ADDRESS", _
                            array(oCellAddr.EndRow+1, oCellAddr.EndColumn+1))
    End If                                  
End Function
edit flag offensive delete link more


My edit is only to add ' at the end of comment line (no need in LibO Basic but here yes....)

pierre-yves samyn gravatar imagepierre-yves samyn ( 2016-08-29 08:19:52 +0200 )edit

Thanks, it does improve format, I'll try to remember to include in future.

mark_t gravatar imagemark_t ( 2016-08-29 14:40:18 +0200 )edit

Question Tools

1 follower


Asked: 2016-08-27 17:43:28 +0200

Seen: 841 times

Last updated: Aug 29 '16