XL 2016 copie de donnees horizontale en verticale

richardlion · 10 Mars 2025

Bonjour a tous, je cherche une solution a mon probleme, en PJ vous trouverez un fichier avec 2 feuilles, une feuille synthèse et une feuille historique dans la feuille historique nous avons deux tableaux, un qui s'apelle TCD SECTEUR DEPOT et l'autre TCD FS DEPOT qui sont normalement Structurés car piloter par un segment de TCD.

quand je fais un filtre sur un seul depot pour ces deux tableaux je souhaite copier uniquement les valeurs des secteurs pour chaque tableau c'est a dire une ligne par tableau pour les copier en verticale dans la feuille SYNTHESE a la place des valeurs stabiloté en vert, l'ancrage de cette copie doit se faire par le nom des TCD SECTEUR DEPOT, TCDFS DEPOT et la date, je dois pouvoir actionner cette macro et aussi l'annuler. Dans la feuille historique il y a aura normalement plusieurs sauvegarde avec pour chaque double tableau une date en haut a gauche, la macro devra pouvoir copier les valeurs du filtre de plusieurs lignes de tableau dans la feuille synthese a partir de la colonne E et sur les futur colonnes suivantes qui se développeront de gauche vers la droite la copie des donnée sera toujours sur les meme lignes de la feuille synthese. a votre disposition pour échange

vgendron · 10 Mars 2025

Bonjour

c'est pas super clair...
dans la PJ:
j'ai renommé les TS de la feuille historique

deux boutons
"Copier filtre" ==> tu selectionnes un filtre dans la première TS , clic bouton ==> le meme filtre est appliqué sur la seconde TS

"Transferer ligne" ==> tu selectionnes un filtre dans la première TS, clic bouton==> le meme filtre est appliqué ET les lignes sont copiées dans la première feuille

vgendron · 10 Mars 2025

et avec un segment pour selectionner facilement une ville

richardlion · 10 Mars 2025

vgendron à dit:
et avec un segment pour selectionner facilement une ville

merci a toi pour le travail je teste la macro pour te dire

fanch55 · 10 Mars 2025

Salut,
Un premier jet qui fait la première partie demandée ( filtre + copie dans l'existant ).
Nota, il y a 2 segments dont 1 masqué, chaque Ts a une ligne de totaux .
Une remarque : la feuille Synthèse n'indique pas quel est le dépôt des données copiées .

richardlion · 16 Mars 2025

fanch55 à dit:
Salut,
Un premier jet qui fait la première partie demandée ( filtre + copie dans l'existant ).
Nota, il y a 2 segments dont 1 masqué, chaque Ts a une ligne de totaux .
Une remarque : la feuille Synthèse n'indique pas quel est le dépôt des données copiées .

Bonjour Ta macro est bonne mais ne focntionne pas dans mon fichier original, dans ta macro si je lis correctement tu as mis en place deux segments masqués moi je n'ai qu'un segment qui pilote les deux tableaux structures (historique des tcd). j'ai copie dans ta macro dans ma feuille historique tcd mais rien ne se passe, mon fichier original étant trop lourd je ne peux l'envoyer , puis je te le faire parvenir par transnow ou une autre manière, merci a toi

fanch55 · 16 Mars 2025

richardlion à dit:
Bonjour Ta macro est bonne mais ne focntionne pas dans mon fichier original, dans ta macro si je lis correctement tu as mis en place deux segments masqués moi je n'ai qu'un segment qui pilote les deux tableaux structures (historique des tcd). j'ai copie dans ta macro dans ma feuille historique tcd mais rien ne se passe, mon fichier original étant trop lourd je ne peux l'envoyer , puis je te le faire parvenir par transnow ou une autre manière, merci a toi

Pas de problème, tu peux mettre le lien vers ton classeur, Cjoint, Transfernow, Gdrive ou autre

job75 · 16 Mars 2025

Bonsoir à tous,

Pourquoi utiliser des filtres ?

Dans la feuille HISTORIQUE 1 sélectionner une cellule du 1er tableau puis clic droit.

Les cellules en jaune sont copiées vers la feuille SYNTHESE :

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Union([Tableau2], [Tableau2].Offset(16)).Interior.ColorIndex = xlNone
If Target.Count > 1 Or Intersect(Target, [Tableau2]) Is Nothing Then Exit Sub
Union(Target(, 3 - Target.Column).Resize(, 7), Target(17, 3 - Target.Column).Resize(, 7)).Interior.Color = vbYellow
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Or Intersect(Target, [Tableau2]) Is Nothing Then Exit Sub
Cancel = True
Sheets("SYNTHESE").[E25:E31] = Application.Transpose(Target(, 3 - Target.Column).Resize(, 7))
Sheets("SYNTHESE").[E50:E56] = Application.Transpose(Target(17, 3 - Target.Column).Resize(, 7))
MsgBox "Feuille SYNTHESE mise à jour"
End Sub

A+

richardlion · 16 Mars 2025

fanch55 à dit:
Pas de problème, tu peux mettre le lien vers ton classeur, Cjoint, Transfernow, Gdrive ou autre

dans le fichier j'ai un onglet MODOP avec je que je cherche comme macro
C:\Users\R5613899\Desktop\COREG COMAG\TEST MACRO INDICATEUR REGION\JOSS\SYNTHESE KPI JOSS BIS.xlsm

richardlion · 17 Mars 2025

richardlion à dit:
dans le fichier j'ai un onglet MODOP avec je que je cherche comme macro
C:\Users\R5613899\Desktop\COREG COMAG\TEST MACRO INDICATEUR REGION\JOSS\SYNTHESE KPI JOSS BIS.xlsm

job75 à dit:

Bonsoir à tous,

Pourquoi utiliser des filtres ?

Dans la feuille HISTORIQUE 1 sélectionner une cellule du 1er tableau puis clic droit.

Les cellules en jaune sont copiées vers la feuille SYNTHESE :

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Union([Tableau2], [Tableau2].Offset(16)).Interior.ColorIndex = xlNone
If Target.Count > 1 Or Intersect(Target, [Tableau2]) Is Nothing Then Exit Sub
Union(Target(, 3 - Target.Column).Resize(, 7), Target(17, 3 - Target.Column).Resize(, 7)).Interior.Color = vbYellow
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Or Intersect(Target, [Tableau2]) Is Nothing Then Exit Sub
Cancel = True
Sheets("SYNTHESE").[E25:E31] = Application.Transpose(Target(, 3 - Target.Column).Resize(, 7))
Sheets("SYNTHESE").[E50:E56] = Application.Transpose(Target(17, 3 - Target.Column).Resize(, 7))
MsgBox "Feuille SYNTHESE mise à jour"
End Sub

A+

Merci pour ta macro qui est tres bien mais je vais avoir plusieurs tableaux dans ma feuille historique qui devront en 1 clic prendre la place des meme cellules dans la feuille synthese sur plusieurs colonnes

fanch55 · 17 Mars 2025

richardlion à dit:
dans le fichier j'ai un onglet MODOP avec je que je cherche comme macro
C:\Users\R5613899\Desktop\COREG COMAG\TEST MACRO INDICATEUR REGION\JOSS\SYNTHESE KPI JOSS BIS.xlsm

Le lien n'est pas bon

richardlion · 17 Mars 2025

fanch55 à dit:
Le lien n'est pas bon

pour que le lien fonctionne ou dois je deposer le fichier?

job75 · 17 Mars 2025

Bonjour richardlion, le forum,

richardlion à dit:
Merci pour ta macro qui est tres bien mais je vais avoir plusieurs tableaux dans ma feuille historique qui devront en 1 clic prendre la place des meme cellules dans la feuille synthese sur plusieurs colonnes

Il suffit de traiter tous les tableaux :

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim LO As ListObject, c As Range
For Each LO In ListObjects
    LO.Range.Resize(LO.Range.Rows.Count + 1).Interior.ColorIndex = xlNone
Next LO
If Target.Count > 1 Or Intersect(Target, Range(ListObjects(1).Name)) Is Nothing Then Exit Sub
For Each LO In ListObjects
    Set c = LO.Range.Cells(Target.Row - ListObjects(1).Range.Row + 1, 1)
    c(1, 2).Resize(, 7).Interior.Color = vbYellow
Next LO
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Or Intersect(Target, Range(ListObjects(1).Name)) Is Nothing Then Exit Sub
Dim LO As ListObject, c As Range, cc As Range
Cancel = True
For Each LO In ListObjects
    Set c = LO.Range.Cells(Target.Row - ListObjects(1).Range.Row + 1, 1)
    Set cc = Sheets("SYNTHESE").Columns(1).Find(LO.Range(1), , xlValues, xlWhole)
    If Not cc Is Nothing Then cc(2, 5).Resize(7) = Application.Transpose(c(1, 2).Resize(, 7))
Next LO
MsgBox "Feuille SYNTHESE mise à jour"
End Sub

Il faut bien sûr que chaque tableau ait sa correspondance dans la feuille SYNTHESE.

A+

fanch55 · 17 Mars 2025

richardlion à dit:
pour que le lien fonctionne ou dois je deposer le fichier?

Aller sur https://www.cjoint.com/ , uploader le fichier puis indiquer le lien fourni içi

richardlion · 17 Mars 2025

fanch55 à dit:
Aller sur https://www.cjoint.com/ , uploader le fichier puis indiquer le lien fourni içi

Document OCrpHKzROfe - Non disponible

Ce document n'est plus disponible sur CJoint.

www.cjoint.com

voici le lien tu as une feuille modop pour les explications si pas claire je suis la

XL 2016 copie de donnees horizontale en verticale

richardlion

XLDnaute Occasionnel

Pièces jointes

vgendron

XLDnaute Barbatruc

Pièces jointes

vgendron

XLDnaute Barbatruc

Pièces jointes

richardlion

XLDnaute Occasionnel

fanch55

XLDnaute Barbatruc

Pièces jointes

richardlion

XLDnaute Occasionnel

fanch55

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

richardlion

XLDnaute Occasionnel

richardlion

XLDnaute Occasionnel

fanch55

XLDnaute Barbatruc

richardlion

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Pièces jointes

fanch55

XLDnaute Barbatruc

richardlion

XLDnaute Occasionnel

Document OCrpHKzROfe - Non disponible

Discussions similaires

XL 2016 copie de donnees horizontale en verticale

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Occasionnel

Discussions similaires

Privacy & Transparency

Privacy & Transparency