[VBA]en fonction d'une valeur choisie copier les lignes d'un tableau

Le titre étant limité en caractère j'exprime ici mon besoin:

je souhaite en fonction de valeurs choisies dans un formulaire, vérifier si cette valeur est présente dans un tableau et si oui (prendre en compte la possibilité qu'elle ne s'y trouve pas) copier les lignes dans un tableau sur une autre feuille qui aurait la même structure.

Ce second tableau étant "provisoire" il serait intéressant de le vider de son contenu lorsque le bouton valider.

cela donne concrètement, je choisis des valeurs

image

a l'aide du bouton valider:

  • vider le fichier temporaire déclaré TS_scop_L3 dans la macro
  • vérifier la présence des valeurs du listbox liste_vrf dans TS_spine.listcolumns("Test1")
  • si la valeur n'est pas trouvé on passe à la suivante, si elle est trouvé, copie des lignes où la valeur se trouve dans le tableau TS_scop_L3
  • on passe à la valeur suivante, et on ajoute à la suite les lignes de la valeur suivante

Je joins le fichier avec mon formulaire épuré qui reprend ma demande. Je suis à l'écoute de vos remarques. Je ne suis pas à l'abri d'avoir omis qqch

2sitting-bull.xlsm (132.88 Ko)

Bonjour,

ci-jointe une proposition

2sitting-bull1.xlsm (133.47 Ko)

Bonjour Thev merci de t'être penché sur mon cas.

Qqs remarques observées:

- si je choisis la valeur 001 (présentes plusieurs fois) seule la première ligne est reprise

- si je choisis une valeur non présente il insère une ligne vide, peut on envisager que si valeur pas trouvée il ne fait rien

- dernier point, l'insertion de lignes ne respecte pas le formatage (couleur des lignes) du tableau de destination mais toutes les lignes insérées prennent le formatage de la ligne d'en tete

image

Bonjour,

ci-jointe correction

1sitting-bull2.xlsm (137.20 Ko)

Merci bcp

C'est exactement la finalité recherchée

me reste plus qu'à adapter cela à fichier travail.

Excellente fin de journée à toi

Je cloture avec brio ce fil

Cordialement

Une petite question

Lorsque je l'adapte à mon fichier travail...je rencontre un petit problème de copier/coller

image

Pour quelques colonnes il me copie la formule et non pas la valeur de la formule du tableau source

Bonjour,

Pas de souci, il suffit de modifier cette instruction:

TS_scop_L3.ListRows(j2).Range.Formula = TS_spine.ListRows(j1).Range.Formula

par :

TS_scop_L3.ListRows(j2).Range.Value = TS_spine.ListRows(j1).Range.Value

Supeeeeeer!

Un grand merci pour ton aide

Un dernier point, si je souhaites (car j'ai plusieurs tableaux à traiter) adapter ce code à plusieurs tableaux

For i = 0 To .ListCount - 1
            Set cell = TS_spine.ListColumns("vpn-instance").DataBodyRange.Find(.list(i, 0), LookAt:=xlWhole)
            If Not cell Is Nothing Then
                Set cell1 = cell
                Do
                    j1 = cell.Row - TS_spine.HeaderRowRange.Row
                    Set ligne = TS_scop_L3.ListRows.Add: j2 = ligne.index
                    TS_scop_L3.ListRows(j2).Range.Value = TS_spine.ListRows(j1).Range.Value
                    Set cell = TS_spine.ListColumns("vpn-instance").DataBodyRange.FindNext(cell)
                Loop Until cell.Address = cell1.Address
            End If

j'ai tenté de reproduire en adaptant mais cela bloque pour le deuxième tableau à la ligne If Not cell is Nothing then

   With Me.liste_vrf

        For i = 0 To .ListCount - 1
            Set cell = TS_spine.ListColumns("vpn-instance").DataBodyRange.Find(.list(i, 0), LookAt:=xlWhole)
            If Not cell Is Nothing Then
                Set cell1 = cell
                Do
                    j1 = cell.Row - TS_spine.HeaderRowRange.Row
                    Set ligne = TS_scop_L3.ListRows.Add: j2 = ligne.index
                    TS_scop_L3.ListRows(j2).Range.Value = TS_spine.ListRows(j1).Range.Value
                    Set cell = TS_spine.ListColumns("vpn-instance").DataBodyRange.FindNext(cell)
                Loop Until cell.Address = cell1.Address
            End If

            Set cell = TS_L2.ListColumns("VRF").DataBodyRange.Find(.list(i, 0), LookAt:=xlWhole)
            If Not cell Is Nothing Then
                Set cell1 = cell
                Do
                    j1 = cell.Row - TS_L2.HeaderRowRange.Row
                    Set ligne = TS_scop_L2.ListRows.Add: j2 = ligne.index
                    TS_scop_L2.ListRows(j2).Range.Value = TS_L2.ListRows(j1).Range.Value
                    Set cell = TS_L2.ListColumns("VRF").DataBodyRange.FindNext(cell)
                Loop Until cell.Address = cell1.Address
            End If

        Next i

    End With

C'est bon cela fonctionne

merci

Rechercher des sujets similaires à "vba fonction valeur choisie copier lignes tableau"