XL 2013 Extraction de données d'un tableau vers un autre

[Cyril-neo]

Bonjour à tous,

tous d'abord je tiens à notifié que je ne connais quasiment rien au VBA mais j'essais d'apprendre.
Je souhaiterai pouvoir compiler des données venant de plusieurs tableaux vers un tableau récapitulatif.

les tableaux visé pour l'extraction se trouve sur la feuille "Perte de charge" et sont les tableau N° 3 et 4 pour qu'ils déversent les informations voulu (seulement certaine colonne) vers le tableau N°2 de la feuille "Extraction Note", mais je ne veux pas que les ligne vide se transfert.

J'ai déjà réalisé l'action pour l'extraction du tableau N°1(feuille "Perte de charge") vers le Tableau N°6 (feuille "Extraction Note") en utilisant l'enregistreur de Macro mais cela ne permet pas de ne pas copié les Lignes vide.

En Moyenne mes tableaux comporterons une cinquantaine de ligne.

Pouvez vous m'aider

 

[Wayki]

Bonjour,

Sub test()
Dim cellule As Range, ws As Worksheet
Set ws = Worksheets("extraction note")
For Each cellule In Range("Tableau3[Cône]")
    If cellule <> "" Then
    Dim row As ListRow
    Set row = ActiveSheet.ListObjects("Tableau2").ListRows.Add()
    With row.Range
        .Cells(1) = cellule
        .Cells(2) = cellule.Offset(0, 1)
        .Cells(3) = cellule.Offset(0, 2)
        .Cells(4) = cellule.Offset(0, 3)
        .Cells(5) = cellule.Offset(0, 6)
        .Cells(6) = cellule.Offset(0, 8)
        .Cells(7) = cellule.Offset(0, 5)
        .Cells(8) = cellule.Offset(0, 12)
        .Cells(9) = cellule.Offset(0, 13)
    End With
    End If
Next cellule
Set row = Nothing
For Each cellule In Range("Tableau4[Cône]")
    If cellule <> "" Then
    Set row = ActiveSheet.ListObjects("Tableau2").ListRows.Add()
    With row.Range
        .Cells(1) = cellule
        .Cells(2) = cellule.Offset(0, 1)
        .Cells(3) = cellule.Offset(0, 2)
        .Cells(4) = cellule.Offset(0, 3)
        .Cells(5) = cellule.Offset(0, 6)
        .Cells(6) = cellule.Offset(0, 8)
        .Cells(7) = cellule.Offset(0, 5)
        .Cells(8) = cellule.Offset(0, 12)
        .Cells(9) = cellule.Offset(0, 13)
    End With
    End If
Next cellule
End Sub

A +

 

[Cyril-neo]

Bonjour @Wayki, et Merci pour ce code.
Je rencontre toutefois 2 petit problème avec.
le 1er est quand je l'utilise via le bouton de lecture dans VBA, et en étant sur la feuille "Extraction Note" tous fonctionne mais des que je le met en bouton de commande il indique une erreur "erreur Exécution 9", je suppose que cela doit être en relation avec la sélection de la feuille car si je relance sans être sur la feuille cela me lance encore l'erreur.

Quand je lance le débuggeur c'est sur cette ligne qu'il s'arête
"Set row = ActiveSheet.ListObjects("Tableau2").ListRows.Add()"

Le 2ième est la dernière cellule du tableau 4 (feuille perte de charge") qui ne se copie pas dans le tableau 2 (Feuille "extraction Note")

Peut tu m'aider?

 

[Phil69970]

Bonjour à vous tous

Juste en passant et en lisant ça :

si je relance sans être sur la feuille cela me lance encore l'erreur.

et après ça :

Quand je lance le débuggeur c'est sur cette ligne qu'il s'arête
"Set row = ActiveSheet.ListObjects("Tableau2").ListRows.Add()"

Pour moi c'est normal que cela plante car activesheet fait reference à la feuille active donc il cherche le tableau2 sur la feuille active et donc plantage car il n'y a pas de tableau2 sur la feuille active CQFD.

Comme c'est un tableau et qu'il ne peut pas avoir 2 tableaux avec le même nom il faudrait plutôt écrire

Set row =ListObjects("Tableau2").ListRows.Add()

Excel ce débrouillera pour trouver ce fameux tableau2

@Phil69970

 

[Cyril-neo]

Merci @Phil69970