Copiare dati Filtrati in un altro foglio

[Luka2017]

Ciao ho questa formula che mi filtra i dati in un foglio e vorrei che me li copia riga per riga tramite lastrow in un altro foglio

Grazie

Codice: Seleziona tutto

Sub Search_ID
Dim LB
Dim oCell
Dim oFilterDesc
Dim oTextBox
Dim oFields(0) As New com.sun.star.sheet.TableFilterField2
Sheet = ThisComponent.Sheets(1)
oTextBox = oDialogo2.getControl("TextField3")
LB = oDialogo2.getControl("ListBox1")
LB.removeItems(0,LB.getItemCount())
Daric = UCase(oTextBox.Text)
c = Sheet.createCursor
c.gotoEndOfUsedArea(false)
LastRow = c.RangeAddress.EndRow + 1
CellRange = Sheet.getCellRangeByName("B2:B" & LastRow)
oFilterDesc = CellRange.createFilterDescriptor(True)

  With oFields(0)
      .Field = 0
      .Operator = com.sun.star.sheet.FilterOperator2.BEGINS_WITH
      .StringValue = Daric
  End With
oFilterDesc = CellRange.createFilterDescriptor(True)

With oFilterDesc
    .ContainsHeader = False
    .CopyOutputData = False
    .FilterFields2 = oFields()
    
End With    

CellRange.filter(oFilterDesc)
ranges = CellRange.queryVisibleCells()

If Ubound(ranges.RowDescriptions) > -1 Then 
  ReDim Arr(0 To Ubound(ranges.RowDescriptions))
  Dim a(0 To Ubound(ranges.RowDescriptions))
  For Each oCell in ranges.Cells
        Arr(x) = oCell.CellAddress.Row 
       a(x) = oCell.DataArray(0)
       x = x +1
  Next 
   Dati = a
   svc = createUnoService("com.sun.star.sheet.FunctionAccess")
   Dati1 =  svc.callFunction("TRANSPOSE", Array(a))

   LB.getModel.StringItemList = Dati1(0)
End if   
   'Call RemoveSheetFilter()
End sub 

[patel]

Cosa intendi per copiare riga per riga tramite lastrow ? lastrow non è una funzione né un metodo, ma il nome di una variabile usata da qualcuno per indicare l'ultima riga di un foglio

[Luka2017]

Mi spiego meglio. Nella Sheet 1 sono presenti i dati filtrati tramite la macro che ti ho postato prima. Vorrei sapere se esiste una macro che mi permette di copiare i dati filtrati nella Sheet 1 e incollarli nella Sheet 4. Ovviamente mano a mano che filtro i dati e poi li incollo nel foglio 4, nel foglio 4 deve tenere in considerazione l'ultima riga scritta per continuare ad incollare i dati successivi.
Grazie mille

[patel]

Le macro non esistono, vanno create, questa copia da foglio1 a foglio2, adattala al tuo caso

Codice: Seleziona tutto

Sub copiaSuFoglio2
doc = ThisComponent
Sh1 = doc.Sheets(0)
Sh2 = doc.Sheets(1)
c = Sh1.createCursor
c.gotoEndOfUsedArea(false)
LastRow1 = c.RangeAddress.EndRow + 1
c = Sh2.createCursor
c.gotoEndOfUsedArea(false)
LastRow2 = c.RangeAddress.EndRow + 1
Range = Sh1.getCellRangeByName("A1:B" & LastRow1 ).getRangeAddress()
CellAddress  = Sh2.getCellRangeByName("A" & LastRow2 ).getCellAddress()  
Sh1.copyRange(CellAddress, Range)

end sub

[unlucky83]

Codice: Seleziona tutto

With oFilterDesc
    .ContainsHeader = False
    .CopyOutputData = False

Puoi sfruttare la proprietà CopyOutputData e OutputPosition
https://www.openoffice.org/api/docs/com ... iptor.html

[patel]

molto meglio, non considerare il mio suggerimento

[Luka2017]

Grazie Patel il tuo suggerimento funziona