Macro to place one cell at the end of another cell

Hello. I have a spreadsheet where I need the contents of the cell below to be cut and pasted at the end of the cell above. Then delete the empty row below.

Thank you for your help!

Do you want to do this only for rows 94 and 95, or for all rows on the sheet? Do you want to concatenate the texts of the cells exactly as shown in the figure, or do you still need to leave a space between them? What macro have you already made and why don’t you like it?

Suggestion in Basic, start with the top cell selected

Sub Join ''''Start with top cell selected
Dim oSel as Object
Dim Var1$, Var2$
dim document   as object
dim dispatcher as object
oSel = ThisComponent.getCurrentSelection()
Var1 = oSel.getString()
REM msgBox Var1

document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(1) as new com.sun.star.beans.PropertyValue
args1(0).Name = "By"
args1(0).Value = 1
args1(1).Name = "Sel"
args1(1).Value = false
dispatcher.executeDispatch(document, ".uno:GoDown", "", 0, args1())

oSel = ThisComponent.getCurrentSelection()
REM Var2 = oSel.getString()
msgBox Var2

dispatcher.executeDispatch(document, ".uno:DeleteRows", "", 0, Array())
Var1 = Var1 + " " + Var2
msgBox Var1

dispatcher.executeDispatch(document, ".uno:GoUp", "", 0, Array())
dim args5(0) as new com.sun.star.beans.PropertyValue
args5(0).Name = "StringName"
args5(0).Value = Var1
dispatcher.executeDispatch(document, ".uno:EnterString", "", 0, args5())

End Sub

For some rows. Not all rows. A space between them would be nice. I have no macro because the ones that I tried to make would not work and deleted some of the information.

schiavinatto thank you for your coding. It works as long as I place the cursor in the cell above. For instance, I want to cut data from cell below and add to cell above, I need to be in the cell above then run your code.
Thank you very much!

schiavinatto would it be possible to not have the boxes pop up and click on them. Just let the code run?

Just comment out the lines that create the message boxes, i.e. that start with msgBox

1 Like

Fixed, see above.

I had to change your code just slightly. I wanted to post in case someone copies the above code and has trouble with it. This is the corrected code with changed code in bold.

Sub Join ‘’’'Start with top cell selected
Dim oSel as Object
Dim Var1$, Var2$
dim document as object
dim dispatcher as object
oSel = ThisComponent.getCurrentSelection()
Var1 = oSel.getString()
REM msgBox Var1

document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService(“com.sun.star.frame.DispatchHelper”)
dim args1(1) as new com.sun.star.beans.PropertyValue
args1(0).Name = “By”
args1(0).Value = 1
args1(1).Name = “Sel”
args1(1).Value = false
dispatcher.executeDispatch(document, “.uno:GoDown”, “”, 0, args1())

oSel = ThisComponent.getCurrentSelection()
Var2 = oSel.getString()
REM msgBox Var2

dispatcher.executeDispatch(document, “.uno:DeleteRows”, “”, 0, Array())
Var1 = Var1 + " " + Var2
REM msgBox Var1

dispatcher.executeDispatch(document, “.uno:GoUp”, “”, 0, Array())
dim args5(0) as new com.sun.star.beans.PropertyValue
args5(0).Name = “StringName”
args5(0).Value = Var1
dispatcher.executeDispatch(document, “.uno:EnterString”, “”, 0, args5())

End Sub

With Python is trivial, is necessary select cells first.

    doc = XSCRIPTCONTEXT.getDocument()
    sel = doc.CurrentController.Selection
    new_value = f"{sel.DataArray[0][0]} {sel.DataArray[1][0]}"
    sel.DataArray = ((new_value,), ('',))
    sel.Spreadsheet.Rows.removeByIndex(sel.RangeAddress.EndRow, 1)

elmau, I don’t understand if that is the total sum of the code or if you want me to change what schiavinatto suggested