[Résolu][Calc] Copier cellules non contigues d'une feuille à une autre feuille

[Grande Ourse]

Bonjour,

J’ai quelques problèmes avec la présente macro qui fonctionne partiellement.
1) La copie ne se fait pas sur la première ligne libre "GoDownToEndOfData" et et lors d'un enregistrement subséquent ne va pas à la ligne suivante..
2) La cellule A1 est copié sur la colonne A mais avec une couleur d'arrière plan et inclus l'image du bouton.
3) Le titre de la cellule B3 est copié sur 2 cellules (C & D) et avec couleur d'arrière plan, au lieu de seulement la cellule D sans arrière plan.
4) La copie des cellules A4, A5, A7 et A8 sont copiées sur les cellules N, O, P et Q mais sans les données (valeurs) des cellules d'origines.
5) La cellule L55 est copiée sur 2 cellules (R & S) avec couleur d'arrière plan au lieu de la cellule R seulement avec donnée (Valeur) de la cellule d'origine.

Votre aide serait grandement appréciée.

Code : Tout sélectionner

Sub Inscription_Registre_des_Brassins
MonDocument = ThisComponent
MesFeuilles = MonDocument.Sheets
Dim MonDoc As Object, MaFeuille As Object, MonCurseur As Object, aCopier as Object
Dim feuilleDepart As Object 'Désigne la feuille source
Dim feuilleArriv As Object 'Désigne la feuille destination
Dim celluleDepart As Object 'Définit la cellule source
Dim celluleArriv As Object 'Définit la cellule de destination
Dim derLigne as long

rem ----------------------------------------------------------------------
'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:GoToStart", "", 0, args1())
'dispatcher.executeDispatch(document, ".uno:GoDownToEndOfData", "", 0, args1())
'dispatcher.executeDispatch(document, ".uno:GoDown", "", 0, args1())

'''''''''''''''''TROUVER LA DERNIERE LIGNE DE DONNÉE DE LA FEUILLE BRASSINS RÉGISTRE'''''''''''''''''''''

MonDocument = ThisComponent
feuilleArriv = MonDocument.getSheets.getByName("Brassins régistre")
MonCurseur = feuilleArriv.createCursor
MonCurseur.gotoEndOfUsedArea( True )
derLigne = MonCurseur.RangeAddress.EndRow+1

feuilleDepart = MesFeuilles.getByName ("Brassage") ' definit la feuille source
celluleDepart = feuilleDepart.getCellRangeByName ("A1")
MonDocument.CurrentController.select(celluleDepart) 'Sélection de la cellule de départ
aCopier = MonDocument.CurrentController.getTransferable() 'Copie
feuilleArriv = MesFeuilles.getByName ("Brassins régistre") ' definit la feuille de destination
celluleArriv = feuilleArriv.getCellRangeByName ("$A$" & derLigne)
MonDocument.CurrentController.select(celluleArriv) 'Selection de la cellule d'arrivée
MonDocument.CurrentController.insertTransferable(aCopier) 'Transfert des données
If celluleDepart.supportsService("com.sun.star.table.CellRange") Then
feuilleArriv.copyRange(celluleDepart.CellAddress, celluleArriv.RangeAddress)
Else Depart
Endif

feuilleDepart = MesFeuilles.getByName ("Brassage")
celluleDepart = feuilleDepart.getCellRangeByName ("B3")
feuilleArriv = MesFeuilles.getByName ("Brassins régistre")
celluleArriv = feuilleArriv.getCellRangeByName ("$C$" & derLigne)
MonDocument.CurrentController.select(celluleArriv) 'Selection de la cellule d'arrivée
MonDocument.CurrentController.insertTransferable(aCopier) 'Transfert des données
If celluleDepart.supportsService("com.sun.star.table.CellRange") Then
feuilleArriv.copyRange(celluleDepart.CellAddress, celluleArriv.RangeAddress)
Else Depart
Endif

feuilleDepart = MesFeuilles.getByName ("Brassage")
celluleDepart = feuilleDepart.getCellRangeByName ("E4")
MonDocument.CurrentController.select(celluleDepart) 'Sélection de la cellule de départ
aCopier = MonDocument.CurrentController.getTransferable() 'Copie
feuilleArriv = MesFeuilles.getByName ("Brassins régistre")
celluleArriv = feuilleArriv.getCellRangeByName ("$N$" & derLigne)
MonDocument.CurrentController.select(celluleArriv) 'Selection de la cellule d'arrivée
MonDocument.CurrentController.insertTransferable(aCopier) 'Transfert des données
If celluleDepart.supportsService("com.sun.star.table.CellRange") Then
feuilleArriv.copyRange(celluleDepart.CellAddress, celluleArriv.RangeAddress)
Else Depart
Endif

feuilleDepart = MesFeuilles.getByName ("Brassage")
celluleDepart = feuilleDepart.getCellRangeByName ("E5")
MonDocument.CurrentController.select(celluleDepart) 'Sélection de la cellule de départ
aCopier = MonDocument.CurrentController.getTransferable() 'Copie
feuilleArriv = MesFeuilles.getByName ("Brassins régistre")
celluleArriv = feuilleArriv.getCellRangeByName ("$O$" & derLigne)
MonDocument.CurrentController.select(celluleArriv) 'Selection de la cellule d'arrivée
MonDocument.CurrentController.insertTransferable(aCopier) 'Transfert des données
If celluleDepart.supportsService("com.sun.star.table.CellRange") Then
feuilleArriv.copyRange(celluleDepart.CellAddress, celluleArriv.RangeAddress)
Else Depart
Endif

feuilleDepart = MesFeuilles.getByName ("Brassage")
celluleDepart = feuilleDepart.getCellRangeByName ("E7")
MonDocument.CurrentController.select(celluleDepart) 'Sélection de la cellule de départ
aCopier = MonDocument.CurrentController.getTransferable() 'Copie
feuilleArriv = MesFeuilles.getByName ("Brassins régistre")
celluleArriv = feuilleArriv.getCellRangeByName ("$P$" & derLigne)
MonDocument.CurrentController.select(celluleArriv) 'Selection de la cellule d'arrivée
MonDocument.CurrentController.insertTransferable(aCopier) 'Transfert des données
MonDocument.CurrentController.select(celluleArriv) 'Selection de la cellule d'arrivée
MonDocument.CurrentController.insertTransferable(aCopier) 'Transfert des données
If celluleDepart.supportsService("com.sun.star.table.CellRange") Then
feuilleArriv.copyRange(celluleDepart.CellAddress, celluleArriv.RangeAddress)
Else Depart
Endif

feuilleDepart = MesFeuilles.getByName ("Brassage")
celluleDepart = feuilleDepart.getCellRangeByName ("E8")
MonDocument.CurrentController.select(celluleDepart) 'Sélection de la cellule de départ
aCopier = MonDocument.CurrentController.getTransferable() 'Copie
feuilleArriv = MesFeuilles.getByName ("Brassins régistre")
celluleArriv = feuilleArriv.getCellRangeByName ("$Q$" & derLigne)
MonDocument.CurrentController.select(celluleArriv) 'Selection de la cellule d'arrivée
MonDocument.CurrentController.insertTransferable(aCopier) 'Transfert des données
If celluleDepart.supportsService("com.sun.star.table.CellRange") Then
feuilleArriv.copyRange(celluleDepart.CellAddress, celluleArriv.RangeAddress)
Else Depart
Endif

feuilleDepart = MesFeuilles.getByName ("Brassage")
celluleDepart = feuilleDepart.getCellRangeByName ("L55")
MonDocument.CurrentController.select(celluleDepart) 'Sélection de la cellule de départ
aCopier = MonDocument.CurrentController.getTransferable() 'Copie
feuilleArriv = MesFeuilles.getByName ("Brassins régistre")
celluleArriv = feuilleArriv.getCellRangeByName ("$R$" & derLigne )
MonDocument.CurrentController.select(celluleArriv) 'Selection de la cellule d'arrivée
MonDocument.CurrentController.insertTransferable(aCopier) 'Transfert des données
If celluleDepart.supportsService("com.sun.star.table.CellRange") Then
feuilleArriv.copyRange(celluleDepart.CellAddress, celluleArriv.RangeAddress)
Else Depart
Endif

'-----Message de confirmation-----
msgbox "L'inscription au régistre est réussie avec succès" ,0, "Bravo !"
End Sub

[yclik]

bonjour
une proposition

Code : Tout sélectionner

Sub Inscription_Registre_des_Brassins
MonDocument = ThisComponent
MesFeuilles = MonDocument.Sheets
Dim MonDoc As Object, MaFeuille As Object, MonCurseur As Object, aCopier as Object
Dim feuilleDepart As Object  'Désigne la feuille source
Dim feuilleArriv As Object      'Désigne la feuille destination
Dim celluleDepart As Object  'Définit la cellule source
Dim celluleArriv As Object      'Définit la cellule de destination
Dim derLigne as long


'dernière ligne
	MonDocument = ThisComponent
	feuilleArriv = MonDocument.getSheets.getByName("Brassins régistre") 

     maZone = feuilleArriv.getCellRangeByName("A1:A100")
	 zoneVide = maZone.queryEmptyCells.RangeAddresses
	 'Je trouve la dernière ligne utilisée
	 derLigne = zoneVide(0).StartRow
	 'J'ajoute 1 pour obtenir la ligne vide
 derLigne =  derLigne + 1

 'copie/colle A1
 
feuilleDepart = MesFeuilles.getByName ("Brassage")  ' definit la feuille source
feuilleArriv = MesFeuilles.getByName ("Brassins régistre") ' definit la feuille de destination

 'copie/colle A1
TextecelluleDepart=feuilleDepart.getCellRangeByName("A1").String 'lire cellule A1
celluleArriv = feuilleArriv.getCellRangeByName ("$A$" & derLigne)
celluleArriv.string=TextecelluleDepart 

'copie B3/colle Cx
TextecelluleDepart=feuilleDepart.getCellRangeByName("B3").String 'lire cellule A1
celluleArriv = feuilleArriv.getCellRangeByName ("$C$" & derLigne)
celluleArriv.string=TextecelluleDepart 


'copie E4/colle Nx
TextecelluleDepart=feuilleDepart.getCellRangeByName("E4").Value 'lire cellule
celluleArriv = feuilleArriv.getCellRangeByName ("$N$" & derLigne)
celluleArriv.value=TextecelluleDepart 

'copie B3/colle Cx
TextecelluleDepart=feuilleDepart.getCellRangeByName("B3").String 'lire cellule
celluleArriv = feuilleArriv.getCellRangeByName ("$C$" & derLigne)
celluleArriv.string=TextecelluleDepart 
'copie E5/colle Ox
TextecelluleDepart=feuilleDepart.getCellRangeByName("E5").Value 'lire cellule
celluleArriv = feuilleArriv.getCellRangeByName ("$O$" & derLigne)
celluleArriv.Value=TextecelluleDepart 
'copie E7/colle Px
TextecelluleDepart=feuilleDepart.getCellRangeByName("E7").String 'lire cellule
celluleArriv = feuilleArriv.getCellRangeByName ("$P$" & derLigne)
celluleArriv.string=TextecelluleDepart 

'copie E8/colle Qx
TextecelluleDepart=feuilleDepart.getCellRangeByName("E8").Value 'lire cellule
celluleArriv = feuilleArriv.getCellRangeByName ("$Q$" & derLigne)
celluleArriv.Value=TextecelluleDepart 
'copie L55/colle Rx
TextecelluleDepart=feuilleDepart.getCellRangeByName("L55").Value 'lire cellule
celluleArriv = feuilleArriv.getCellRangeByName ("$R$" & derLigne)
celluleArriv.Value=TextecelluleDepart 
 
'-----Message de confirmation-----
msgbox "L'inscription au régistre est réussie avec succès" ,0, "Bravo !"
End Sub

[Grande Ourse]

Bonjour Yclick,
Une réponse éclair et qui fonctionne tel que souhaité.

Merçi beaucoup.

Après vérification il y a un petit souçi, lorsque j'utilise l'autofiltre en A1 (tri croissant), j'ai ce message : Les plages contenant des cellules fusionnées ne sont triées que si elles n'ont pas de formatage. Rien à voir avec la macro mais je doit trouvé ce que cela signifie.

Salutations,

[Grande Ourse]

Bonjour,

Pour l'utilisation de l'autofiltre, il faut simplement déverouiller la feuille et la reverouillée lorsque la modification est faite.

Je passe en résolu.

Merçi.

[Dude]

Pourquoi ne pas faire une boucle ?

Code : Tout sélectionner

'copie/colle
aDep = array("A1","B3","E4","B3","E5","E7","E8","L55")
aArr = array("A","C","N","C","O","P","Q","R") 
for i = 0 to UBound(aDep)
	TextecelluleDepart=feuilleDepart.getCellRangeByName(aDep(i)).String 
	celluleArriv = feuilleArriv.getCellRangeByName (aArr(i) & derLigne)
	celluleArriv.string=TextecelluleDepart 
next