# how do I change a ".copyRange" on a macro code to past the the text copied and not the formula

I have had this macro for a while now and never had a problem since I was pasting just text information from a cell range to another sheet. However, now I have a formula in that cell range that copes over, and when the cell range copies to the new sheet the formula is pasted instead of the value. I can solve this if I manually paste it as a "paste special".

    Sub Copy2FirstBlankCell()
Dim oDoc As Object
Dim oSheet As Object
Dim DestinationCell As Object
Dim r As Long
Dim c As Integer

oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)

r = 0
c = 0

Do While DestinationCell.getType() <> com.sun.star.table.CellContentType.EMPTY And r < oSheet.getRows().getCount()
r = r + 1
Loop
If DestinationCell.getType() = com.sun.star.table.CellContentType.EMPTY Then
Else
Msgbox("Ran out of rows.")
EndIf


I believe the solution is at the botom of the code on the Loop area on:

oSheet.copyRange(DestinationAddress,SourceAddress)


But I'm not sure what to change it to

edit retag close merge delete

Sort by » oldest newest most voted

I would write this code like this (it seems to me that this way the macro will work faster):

Sub Copy2FirstBlankRow
Const SOURCE_RANGE_ADDRESS = "Sheet1.A1:F1" ' Here you can set any other range
Const NUMBER_TARGET_SHEET = 1   ' In your code it was "DestinationAddress.Sheet = 1"
Dim oDoc As Variant     ' Active spreadsheet
Dim oSheets As Variant  ' All sheets of current doc
Dim oTargetSheet As Variant ' Target sheet as object
Dim FirstEmptyRow As Long   ' Number of row or -1 if sheet if full
Dim oSourceRange As Variant ' Range of source data as object
Dim oSourceData As Variant  ' Data of source range
Dim oTargetRange As Variant ' Range with dimensions same as source range
oDoc = ThisComponent
oSheets = oDoc.getSheets()
oTargetSheet = oSheets.getByIndex(NUMBER_TARGET_SHEET)
FirstEmptyRow = GetFirstEmptyRow(oTargetSheet)
If FirstEmptyRow < 0 Then
MsgBox("Ran out of rows",16,"The target sheet is full")
Exit Sub
EndIf
On Error Resume Next
On Error GoTo 0
If IsEmpty(oSourceRange) Then
Exit Sub
EndIf
oSourceRange = oSourceRange(0)
oSourceData = oSourceRange.getDataArray()
If FirstEmptyRow + UBound(oSourceData) >= oTargetSheet.getRows().getCount() Then
MsgBox("There is no free space for new data",16,"The target sheet is full")
Exit Sub
EndIf
Rem And now just set data to target range
oTargetRange = oTargetSheet.getCellRangeByPosition(0, FirstEmptyRow, UBound(oSourceData(0)), FirstEmptyRow + UBound(oSourceData))
oTargetRange.setDataArray(oSourceData)
End Sub

Function GetFirstEmptyRow(oSheet As Variant) As Long
Rem Instead of checking cells in a loop, you can use a faster method
Dim oCursor As Variant, lCellAddress As Long
oCursor = oSheet.createCursor()
If lCellAddress = 0 Then ' First row?
GetFirstEmptyRow = 1
If oSheet.getCellByPosition(0,0).getFormula() = "" Then ' A1 is empty, start here
GetFirstEmptyRow = 0
EndIf
EndIf
ElseIf lCellAddress = oSheet.getRows().getCount()-1 Then ' Last row is filled
GetFirstEmptyRow = -1
Else