XL 2016 copie de donnees horizontale en verticale

[richardlion]

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]

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]

et avec un segment pour selectionner facilement une ville

 

[richardlion]

et avec un segment pour selectionner facilement une ville

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

 

[fanch55]

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]

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]

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]

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 :

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]

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]

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

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 :

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]

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]

Le lien n'est pas bon

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

 

[job75]

Bonjour richardlion, le forum,

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 :

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+