Copier-coller entre des tableaux sur différents onglets

Bonjour,

Je souhaite copier-coller des données présentes dans différents tableaux mais j'ai besoin d'aide pour réaliser la macro.

Le principe est que j'ai un onglet "Data" avec des tableaux. Pour chacun, il y a une colonne "choix" dans laquelle il y a parfois des "x". Je voudrais copier les lignes qui ont des "x" et les coller dans un seul tableau sur un autre onglet.

Voici un exemple:

Merci par avance,

David

Bonjour

Une solution PowerQuery, intégré à Excel

Tu peux casser la lien du tableau avec la requête si c'est one shot

J'ai adapté tes noms de tableaux : on ne garde jamais les noms automatiques...

Je n'ai pas mis de tri dans la requête mais on pourrait

Bonjour David, Chris, bonjour le forum,

Une proposition VBA avec le code ci-dessous :

Sub Macro1()
Dim OD As Worksheet 'déclare la variable OD (Onglet Data)
Dim OS As Worksheet 'déclare la variable OS (Onglet Synthese)
Dim TS As ListObject 'déclare la variable TS (Tableau Structuré)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set OD = Worksheets("Data") 'définit l'onglet OD
Set OS = Worksheets("Synthese") 'définit l'onglet OS
For Each TS In OD.ListObjects 'boucle 1 : sur tous les tableaux structurés de l'onglet OD
    TV = Range(TS) 'définit le tableau des valeurs TV
    For I = 1 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV
        If TV(I, 1) = "x" Then 'condition : si la donnée ligne I colonne 1 de TV est égale à "x"
            K = K + 1 'inrémente K
            ReDim Preserve TL(1 To 2, 1 To K) 'redimensionne le tableau des lignes (2 lignes, K colonnes)
            TL(1, K) = TV(I, 2) 'récupère dans la ligne 1 de TL la donnée en colonne 2 de TV (=> Transposition)
            TL(2, K) = TV(I, 3) 'récupère dans la ligne 2 de TL la donnée en colonne 3 de TV (=> Transposition)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
Next TS 'prochain tableau structuré de la boucle 1
OS.ListObjects(1).ListRows.Add 'ajoute une ligne au tableau structuré de l'onglet OS
OS.Range("B3").Resize(K, 2).Value = Application.Transpose(TL) 'renvoie dans B3 redimensionnée le tableau TL transposé
End Sub

Merci Chris et ThauThème pour vos réponses rapides.

Chris,

Je ne connais pas l'outil PowerQuery. J'ai regardé sur youtube et ça a l'air vraiment bien mais j'ai besoin d'une solution que je puisse appliquer rapidement.

ThauThème,

J'ai copié-collé le code dans mon onglet synthèse et j'obtiens ce messager:

Savez-vous pourquoi ?

David

RE

Re,

David, l'erreur est provoquée sur une ligne de code qui devient surlignée de jaune. Pour pouvoir t'aider il ma faudrait savoir qu'elle est la ligne qui génère cette erreur.

Pas de problème en revanche sur ton fichier exemple :

Merci beaucoup pour vos aides.

Chris,

Effectivement j'ai regardé dans PowerQuery et j'ai trouvé la requête. C'est super intéressant. Par contre, je n'ai pas encore compris comment la lancer pour générer le tableau. Je vais chercher.

ThauThème,

La macro fonctionne bien dans le fichier test que vous m'avez envoyé mais pas quand je l'intègre moi même. J'ai reproduit l'erreur avec le code 400 mais je n'ai pas de ligne surlignée en jaune. j'ai regardé rapidement sur interner et c'est une erreur qui semble arrivée de temps en temps sans qu'on n'en connaisse réellement la cause.

En tous cas, La macro correspond complètement à ce que je souhaite.

Merci beaucoup à vous deux. Je vais continuer à étudier vos travaux avant de clôturer le sujet, J' aurais peut être des petites questions.

Bonne soirée,

David

RE

Si tu la copies dans un autre classeur :Fermer charger dans, Table depuis PowerQuery

Sinon afficher le volet Requêtes et connexions depuis l'onglet Données, clic droit sur le nom de la requête, Charger dans, Table

Après pour actualiser : Données, Actualiser tout ou bien clic droit sur le tableau de synthèse pour actualiser

Merci Chris, je vais regarder avec les éléments que vous venez de me donner. C'est très intéressant. Pour un quelqu'un comme moi qui galère avec les macros, c'est surement une bonne solution pour mes prochains développements.

ThauThème,

Je viens de transférer le code dans mon fichier complet et ça fonctionne. Une autre question, quand je fais plusieurs manipulations dans les tableaux de l'onglet "Data", au bout d'un moment le tableau dans "Synthèse" a des lignes vides. Selon mes essais. Est-il possible d' ajouter un morceau de code pour que le tableau revienne toujours sans lignes vides ?

Encore merci.

David

Re,

Si tu veux que le tableau se vide à chaque lancement de la macro, essaie comme ça :

Sub Macro1()
Dim OD As Worksheet 'déclare la variable OD (Onglet Data)
Dim OS As Worksheet 'déclare la variable OS (Onglet Synthese)
Dim TS As ListObject 'déclare la variable TS (Tableau Structuré)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set OD = Worksheets("Data") 'définit l'onglet OD
Set OS = Worksheets("Synthese") 'définit l'onglet OS
For Each TS In OD.ListObjects 'boucle 1 : sur tous les tableaux structurés de l'onglet OD
    TV = Range(TS) 'définit le tableau des valeurs TV
    For I = 1 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV
        If TV(I, 1) = "x" Then 'condition : si la donnée ligne I colonne 1 de TV est égale à "x"
            K = K + 1 'inrémente K
            ReDim Preserve TL(1 To 2, 1 To K) 'redimensionne le tableau des lignes (2 lignes, K colonnes)
            TL(1, K) = TV(I, 2) 'récupère dans la ligne 1 de TL la donnée en colonne 2 de TV (=> Transposition)
            TL(2, K) = TV(I, 3) 'récupère dans la ligne 2 de TL la donnée en colonne 3 de TV (=> Transposition)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
Next TS 'prochain tableau structuré de la boucle 1
On Error Resume Next 'getion des erreurs (en cas d'erreur passe à la ligne suivante)
OS.ListObjects(1).DataBodyRange.Delete 'efface toutes les lignes du tableau (génère une erreur si le tableau est vide)
OS.Range("B3").Resize(K, 2).Value = Application.Transpose(TL) 'renvoie dans B3 redimensionnée le tableau TL transposé
End Sub

J'avoue que je ne maîtrise pas bien les tableaux structurés...

Merci beaucoup, la macro fonctionne super bien.

Je vais regarder les powerquery maintenant.

David