[Risolto] Macro Sposta dati da una riga ad un altra

[Andrea Toniolo]

Buongiorno a tutti,
Vi chiedo se fosse possibile avere un aiuto per scrivere una macro che automatizzi lo spostamento di dati da una riga ad un altra nello stesso foglio.
Mi spiego meglio:
Nel Foglio1, Range A1:D1 ho dei valori.
La Macro deve spostare i dati due righe più sotto (Range A3:D3), ripulire A1:D1 e al successivo inserimento deve scrivere i dati nella prima riga vuota.
Purtroppo non sono in grado di scriverla da solo, ho cercato nel forum ma ho trovato solo macro che fanno lo stesso lavoro che vorrei fare io ma da un foglio ad un altro e non sono riuscito a modificarla.

Vi ringrazio anticipatamente e spero di riuscire a risolvere questo problema

[patel]

allega un file di esempio con i dati ed il risultato desiderato

[Andrea Toniolo]

Ciao e grazie per l'interessamento,
in pratica come puoi vedere nell'esempio allegato, la macro attivabile dal pulsante, deve spostare i dati inseriti nel range di celle A2:D2 nella tabella sottostante andando a scrivere nella prima riga vuota e a pulire il range appena citato A2:D2.
Successivamente avevo pensato di agganciare una macro che allo stesso tempo li ordini in ordine di data, ma questo non dovrebbe essere un problema.

Rimango a disposizione per eventuali chiarimenti

Ancora Grazie

[patel]

prova questa

Codice: Seleziona tutto

sub CopiaIncollaUltimaRiga 
Doc = ThisComponent
Sheet = Doc.Sheets(0)
LastRow =LastRowInColonna(Sheet,0) + 2
Sheet.getCellRangeByName("A" & Lastrow & ":D" & Lastrow).setDataArray(Sheet.getCellRangeByName("A2:D2").getDataArray
End Sub

Function LastRowInColonna(oSheet As Object, Col As Long) As Long
  Dim c As Object, oRangePiena As Object, LastRow As Long
  c = oSheet.createCursor
  c.gotoEndOfUsedArea(false)
  LastRow = c.RangeAddress.EndRow
  oRangePiena = oSheet.getCellRangeByPosition(Col, 0, Col, LastRow).queryContentCells(1+2+4).RangeAddresses
  If Ubound(oRangePiena) < 0 Then
       LastRowInColonna = - 1
  Else   
       LastRowInColonna = oRangePiena(Ubound(oRangePiena)).EndRow
  End if 
End Function

[Andrea Toniolo]

Grazie,
Domani la provo e ti faccio sapere
Buona serata

[Andrea Toniolo]

Ciao,
Ho provato la tua Macro che in linea di massima va bene, solo che non riesco ad adattarla al mio reale foglio, sono alle prime armi con Calc ed è più difficile di quello che pensavo .
Potresti per cortesia aiutarmi ad adattarlo al reale foglio?
I dati vengono scritti nel Range di Celle E4:O4 e devono essere spostati dalla prima riga sottostante E5:O5.
Inoltre dovendo pensavo di creare con il registratore di Macro anche una macro che cancella i dati nella riga iniziale dopo averli spostati e una che ordina i dati nella tabella per data, ti volevo chiedere come fare ad eseguire contemporaneamente più macro con lo stesso comando, con excel ero in grado di farlo, funziona nello stesso modo?
Allego il nuovo esempio e ti ringrazio per la tua disponibilità e pazienza

Buona giornata

[patel]

il basic di Calc è molto diverso ed il registratore di macro produce codice incomprensibile e spesso non funzionante.
un buon testo è http://www.pitonyak.org/oo.php

Codice: Seleziona tutto

sub CopiaIncollaUltimaRiga
Doc = ThisComponent
Sheet = Doc.Sheets.getByName("prova") 
LastRow =LastRowInColonna(Sheet,4) + 2 ' 4 indica la colonna E (su calc la numerazione inizia da zero)
Sheet.getCellRangeByName("E" & Lastrow & ":O" & lastrow).setDataArray(Sheet.getCellRangeByName("E4:O4").getDataArray
End Sub

la copia di un range non copia i formati, quindi predisponi la tabella con i formati corretti

[Andrea Toniolo]

Ciao
Ho provato la nuova macro ma mi da un errore che puoi vedere nell'allegato.
GRazie anche per le altre utili indicazioni

[patel]

la nuova macro sostituisce la precedente pari nome e deve essere accompagnata dalla function che rimane immutata

Codice: Seleziona tutto

sub CopiaIncollaUltimaRiga
Doc = ThisComponent
Sheet = Doc.Sheets.getByName("prova")
LastRow =LastRowInColonna(Sheet,4) + 2 ' 4 indica la colonna E (su calc la numerazione inizia da zero)
Sheet.getCellRangeByName("E" & Lastrow & ":O" & lastrow).setDataArray(Sheet.getCellRangeByName("E4:O4").getDataArray
End Sub

Function LastRowInColonna(oSheet As Object, Col As Long) As Long
  Dim c As Object, oRangePiena As Object, LastRow As Long
  c = oSheet.createCursor
  c.gotoEndOfUsedArea(false)
  LastRow = c.RangeAddress.EndRow
  oRangePiena = oSheet.getCellRangeByPosition(Col, 0, Col, LastRow).queryContentCells(1+2+4).RangeAddresses
  If Ubound(oRangePiena) < 0 Then
       LastRowInColonna = - 1
  Else   
       LastRowInColonna = oRangePiena(Ubound(oRangePiena)).EndRow
  End if 
End Function

[Andrea Toniolo]

Ciao,
Grazie per la correzione, non avevo capito.
Ora la macro funziona correttamente e sono riuscito anche a registrare le altre due che ordinano per data la tabella e puliscono la prima riga.
Per eseguirle contemporaneamente ho creato una quarta macro che richiama le prime tre in ordina:
Call CopiaSotto
Call Ordina
Call Pulisci PrimaRiga
Grazie ancora del tuo preziosissimo supporto e di tutti quelli come te che si dedicano a questo utilissimo Forum.

Buona giornata a tutti