[Résolu][Calc] copier coller plusieurs lignes en meme temps

[Nikky-974]

Bonjour à tous.
j'essaie de me débrouiller un peu mais je bloque sur un élément.
J'ai un tableau nommé A qui répertorie un genre d'inventaire.
Je souhaite dans mon tableau B intégrer certaines lignes sous condition ( que le chiffre 1 soit dans la colonne B)
La macro ci dessous (repiquée sur un autre fichier) me permet de le faire ligne par ligne.
Je souhaiterais adapter cette macro en y ajoutant la condition et le déplacement de toutes les lignes incluant cette condition.
Quelqu'un aurait il une idée.

PS : je sais qu'il faudrait joindre un fichier mais mon fichier d'origine est bien trop gros et renseigné avec des données personnelles de plusieurs personnes.
Si le fichier s'avère nécessaire je ferais l'effort d'en produire un similaire.

Cordialement

Code : Tout sélectionner

Sub Renseigner_Stat
Dim oDoc as Object, maFeuille as Object, oDoc1 As Object, AdresseRecap As String, oMois As Variant
   oDoc = thisComponent
   maFeuille = oDoc.CurrentController.ActiveSheet
   sel = oDoc.CurrentSelection
   oDate = maFeuille.getCellByPosition(0,sel.CellAddress.Row).Value
   oNum = maFeuille.getCellByPosition(2,sel.CellAddress.Row).String
   oPersonne = maFeuille.getCellByPosition(3,sel.CellAddress.Row).String
   oDecision = maFeuille.getCellByPosition(18,sel.CellAddress.Row).String
   oMois = maFeuille.getCellByPosition(0,0).String

   
   AdresseRecap = convertToURL("C:\STAT\recap stat.ods")

   dim props(0) as new com.sun.star.beans.PropertyValue

   oDoc1 = StarDesktop.loadComponentFromURL(AdresseRecap, "_blank", 0, props())
   if not isNull(oDoc1) then
   FeuilleDest = oDoc1.Sheets.getByName(oMois)
   oDoc1.CurrentController.ActiveSheet = FeuilleDest
   maZone = FeuilleDest.getCellRangeByName("A5:A34")
   zonesVides = maZone.queryEmptyCells.RangeAddresses
   Y = zonesVides(0).StartRow
   FeuilleDest.getCellByPosition(0,y).Value = oDate
   FeuilleDest.getCellByPosition(1,y).String = oNum
   FeuilleDest.getCellByPosition(2,y).String = oPersonne
   FeuilleDest.getCellByPosition(3,y).String = oDecision
End Sub
End Sub

[Piaf]

Bonjour

Quelqu'un aurait il une idée.

A priori, en mettant un filtre en place sur ton tableau A et en recopiant dans ton tableau B les résultats du filtre.
Pour une mise en œuvre plus détaillée, merci de joindre un fichier.
A+

[Nikky-974]

Bonjour Piaf heureux de voir que tu es toujours de bon secours.
J'avais pensé aux filtres mais je t'avoue que çà ne me fait faire pas mal de manip
je crée une ébauche de mes tableaux et je post le tout. Merci pour ta réponse.

[Nikky-974]

Me voilà de retour avec une ébauche de mes tableaux A et B.
Tableau A : classeur de base dans lequel sont enregistrées toutes les données source.
Tableau B : Classeur destiné à alimenter des statistiques

Je dois envoyer depuis le tableau A vers le tableau B, uniquement les lignes dont la colonne E fait état de "interne" représentés dans cette colonne par le chiffre 1.
La macro en place me permet de transférer les données lignes par lignes en utilisant le bouton "STAT INTERNE".
Cette Macro envoi la ligne qui est active.
Je souhaiterais en fin de mois envoyer grâce à ce clic sur "STAT INTERNE" toutes les lignes ayant 1 dans la colonne E.

Vous remarquerez 2 choses

1 - Seules quelques données de la ligne sont transférées.
2 - Les données sont envoyées dans le classeur B sur différentes feuilles en fonction du mois concerné.

Je dois conserver cette structure en trouvant le moyen d'envoyer plusieurs lignes en 1 seule fois (gros gain de temps).

Merci d'avance à tous pour vos conseils

ci joint mon code actuel :

Code : Tout sélectionner

Sub Renseigner_TableauStat
Dim oDoc as Object, maFeuille as Object, oDoc1 As Object, AdresseRecap As String, oMois As Variant
   oDoc = thisComponent
   maFeuille = oDoc.CurrentController.ActiveSheet
   sel = oDoc.CurrentSelection
   oDate = maFeuille.getCellByPosition(0,sel.CellAddress.Row).Value
   oNum = maFeuille.getCellByPosition(1,sel.CellAddress.Row).String
   oPersonne = maFeuille.getCellByPosition(2,sel.CellAddress.Row).String
   oDecision = maFeuille.getCellByPosition(8,sel.CellAddress.Row).String
   oMois = maFeuille.getCellByPosition(0,0).String

   
   AdresseRecap = convertToURL("C:\STAT\TABLEAU B.ods")

   dim props(0) as new com.sun.star.beans.PropertyValue

   oDoc1 = StarDesktop.loadComponentFromURL(AdresseRecap, "_blank", 0, props())
   if not isNull(oDoc1) then
   FeuilleDest = oDoc1.Sheets.getByName(oMois)
   oDoc1.CurrentController.ActiveSheet = FeuilleDest
   maZone = FeuilleDest.getCellRangeByName("A3:A38")
   zonesVides = maZone.queryEmptyCells.RangeAddresses
   Y = zonesVides(0).StartRow
   FeuilleDest.getCellByPosition(0,y).Value = oDate
   FeuilleDest.getCellByPosition(1,y).String = oNum
   FeuilleDest.getCellByPosition(2,y).String = oPersonne
   FeuilleDest.getCellByPosition(3,y).String = oDecision
   oDoc1.Store
   oDoc1.Close(True)   
End Sub
End Sub

[Piaf]

Re

je crée une ébauche de mes tableaux et je post le tout. Merci pour ta réponse.
Me voilà de retour avec une ébauche de mes tableaux A et B.

Ou est l'ébauche ?

Vous remarquerez 2 choses

Rien remarqué sans les fichiers !
Si j'ai bien compris ta démarche, il faudrait que les volontaires créent eux-même les fichiers qui correspondent à ta macro
A+

[Nikky-974]

Oups désolé oubli de pièce jointe.

[Piaf]

Re
A tester

Code : Tout sélectionner

Sub Renseigner_TableauStat
Dim oDoc as Object, maFeuille as Object,oMois As String
Dim ZO as Object,cellVide as Variant, y1 as Long
Dim AdresseRecap As String, oDoc1 As Object, FeuilleDest as Object, ZD as Object
Dim zonesVides as Variant, y2 as Long, i as Integer
Dim oDate as Double, oNum as String, oPersonne as String, oDecision as String
Dim Arg(0) As New com.sun.star.beans.PropertyValue
	Arg(0).Name = "Hidden"
	Arg(0).Value = True
	oDoc = thisComponent
	maFeuille = oDoc.CurrentController.ActiveSheet
	oMois = maFeuille.getCellByPosition(0,0).String
	ZO = maFeuille.getCellRangeByName("A1:A100")
	cellVide = ZO.queryEmptyCells.RangeAddresses
	y1 = cellVide(0).StartRow
	AdresseRecap = convertToURL("C:\STAT\TABLEAU B.ods")
	oDoc1 = StarDesktop.loadComponentFromURL(AdresseRecap, "_blank", 0, Arg())
	FeuilleDest = oDoc1.Sheets.getByName(oMois)
	ZD = FeuilleDest.getCellRangeByName("A3:A38")
	zonesVides = ZD.queryEmptyCells.RangeAddresses
	Y2 = zonesVides(0).StartRow
	For i = 3 To Y1
		If maFeuille.getCellByPosition(4,i).Value = 1 Then
			oDate = maFeuille.getCellByPosition(0,i).Value
			FeuilleDest.getCellByPosition(0,y2).Value = oDate
			oNum = maFeuille.getCellByPosition(1,i).String
			FeuilleDest.getCellByPosition(1,y2).String = oNum
			oPersonne = maFeuille.getCellByPosition(2,i).String
			FeuilleDest.getCellByPosition(2,y2).String = oPersonne
			oDecision = maFeuille.getCellByPosition(8,i).String
			FeuilleDest.getCellByPosition(3,y2).String = oDecision
			y2 = y2 + 1
		End If	
   Next i
   oDoc1.Store
   oDoc1.Close(True)
End Sub

A+

[Nikky-974]

Comme d’habitude Piaf , C'est parfait.
Énorme Merci