Ask Your Question
0

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

asked 2018-09-19 04:54:52 +0100

ehesh gravatar image

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 SourceAddress As New com.sun.star.table.CellRangeAddress
   Dim DestinationAddress As New com.sun.star.table.CellAddress
   Dim DestinationCell As Object
   Dim r As Long
   Dim c As Integer

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

   'CellrangeAddress of Sheet1.B1
   SourceAddress.Sheet = 0
   SourceAddress.StartColumn = 0
   SourceAddress.StartRow = 0
   SourceAddress.EndColumn = 5
   SourceAddress.EndRow = 0

   'CellAddress of Sheet1.A1
   r = 0
   c = 0
   DestinationAddress.Sheet = 1
   DestinationAddress.Column = c
   DestinationAddress.Row = r

   DestinationCell = oDoc.getSheets().getByIndex(DestinationAddress.Sheet).getCellByPosition(c,r)
   Do While DestinationCell.getType() <> com.sun.star.table.CellContentType.EMPTY And r < oSheet.getRows().getCount()
      r = r + 1
      DestinationAddress.Row = r
      DestinationCell = oDoc.getSheets().getByIndex(DestinationAddress.Sheet).getCellByPosition(c,r)
   Loop
   If DestinationCell.getType() = com.sun.star.table.CellContentType.EMPTY Then
      oSheet.copyRange(DestinationAddress,SourceAddress)
   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 flag offensive close merge delete

1 Answer

Sort by » oldest newest most voted
1

answered 2018-09-19 10:24:44 +0100

JohnSUN gravatar image

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
    oSourceRange = oSheets.getCellRangesByName(SOURCE_RANGE_ADDRESS)
    On Error GoTo 0 
    If IsEmpty(oSourceRange) Then 
        MsgBox("Wrong source range address",16,"Fix your code")
        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()
    oCursor.GotoEndOfUsedArea(False)    ' Jump to last used row
    lCellAddress = oCursor.getRangeAddress().EndRow
    If lCellAddress = 0 Then ' First row?
        GetFirstEmptyRow = 1
        If oCursor.getRangeAddress().EndColumn = 0 Then 
            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 
        GetFirstEmptyRow = lCellAddress + 1
    EndIf 
End Function
edit flag offensive delete link more
Login/Signup to Answer

Question Tools

1 follower

Stats

Asked: 2018-09-19 04:54:52 +0100

Seen: 182 times

Last updated: Sep 19 '18