XL 2019 Utiliser lignes d'un filtre d'un tableau structuré dans un tableau

thespeedy20 · 20 Juin 2022

Bonsoir le Forum,

Je filtre mon tableau structuré, ici en l'occurrence , le résultat est de 3 lignes.. l'adressage est bon mais je n'arrive pas à mettre ces 3 lignes dans mon tableau...

VB:

Sub TransfertDCI()     'tranfert de données pour avis

     Dim Compteur As Integer, a As Integer
     Dim tabloR(), tablo
     Dim FDep  As Worksheet: Set FDep = Worksheets("Données")
     Dim Farr  As Worksheet: Set Farr = Worksheets("Débition_Caution_Ind")
     Dim ws  As Worksheet
     Dim LR1 As Long, LR2 As Long
     Dim plage_filtre, x&
  
  
     Application.ScreenUpdating = False
    
      
    
     With FDep
    
    .[A1].AutoFilter 9, "30"
    Set plage_filtre = .[_FilterDataBase]
    x = plage_filtre.Rows.Count - 1
    
    tablo = plage_filtre.Offset(1, 0).Resize(x).SpecialCells(12).Value
    'MsgBox plage_filtre.Offset(1, 0).Resize(x).SpecialCells(12).Address
    
     End With
    
    
          For a = 1 To UBound(tablo) Step 1 '10 noms par fois
          ReDim tabloR(29, 1 To 4) 'vider tabloR
          For Compteur = 0 To 0
               If a + Compteur > UBound(tablo) Then Exit For
               r = Compteur * 2
               tabloR(r, 1) = tablo(a + Compteur, 1) & " " & tablo(a + Compteur, 2)
               tabloR(r + 2, 1) = tablo(a + Compteur, 3)
               tabloR(r + 4, 1) = tablo(a + Compteur, 4) & " à " & tablo(a + Compteur, 5) & " " & tablo(a + Compteur, 6)
              
          Next

          Farr.Range("B33").Resize(UBound(tabloR), UBound(tabloR, 2)) = tabloR
          Farr.Range("C40") = "MONTANT"
          Farr.Range("C42") = "30"
          
                  
    
    
For Each ws In ActiveWorkbook.Worksheets
   If ws.Name <> "Données" And ws.Name <> "DCI" And ws.Name <> "DLI" Then
        LR1 = Sheets("DCI").Range("A" & Rows.Count).End(xlUp).Row
        LR2 = ws.Range("A" & Rows.Count).End(xlUp).Row
        ws.Range("A1:G" & LR2).Copy Destination:=Sheets("DCI").Range("A" & LR1 + 1)
        
   End If
Next ws



     Next
 

  

Application.ScreenUpdating = False
End Sub

Je vous en remercie par avance

OLi

sylvanu · 22 Juin 2022

thespeedy20 à dit:
A chaque nouveau nom, nouvelle feuille ! une feuille unique par personne !

Ca, fallait le comprendre.
Alors à quoi sert donc votre "For Each ws In ActiveWorkbook.Worksheets" puisque vous collez dans DCI ?

Pour trois valeurs à coller, il est plus rapide de coller directement dans la feuille plutôt que de créer un TabloR , le rempli, puis le transférer.

Un essai en PJ. Chaque ligne visible remplit une feuille Débition_Caution_Ind qui est copiée à la queue leuleu dans DCI.

sylvanu · 21 Juin 2022

Pour avancer :
1- Comme dit au post #4 :

Ensuite je n'ai rien compris du remplissage de TabloR.

Ca n'a pas changé. Je ne comprends toujours pas.

2- Avez vous modifié le point concernant les ET en OU du post #4.

3- dans votre fichier vous faites :

VB:

For a = 1 To UBound(tablo) Step 1 '10 noms par fois
  ReDim tabloR(29, 1 To 4) 'vider tabloR

donc vous réinitialisez votre array à chaque tour de a.
Ne devrait on pas avoir plutôt :

Code:

ReDim tabloR(29, 1 To 4) 'vider tabloR
For a = 1 To UBound(tablo) Step 1 '10 noms par fois

où il n'est initialisé qu'au départ.

4- Voici le code. A la ligne "ReDim tabloR(29)" l'array tablo est correct, comme déjà dit.
Pourquoi avoir créer un array TabloR de dimension 4 si vous n'utilisez que l'indice 1. Autant faire TabloR(29).
D'autant que pour le collage cela ne fera pas la même chose. Vous allez essayer de coller 4 colonnes.

VB:

Sub TransfertDCI()     'tranfert de données pour avis
     Dim Compteur%, a%, LR1&, LR2&, plage_filtre, x&, tabloR(), tablo
     Dim FDep  As Worksheet: Set FDep = Worksheets("Données")
     Dim Farr  As Worksheet: Set Farr = Worksheets("Débition_Caution_Ind")
     Dim ws  As Worksheet
    Application.ScreenUpdating = False
    ReDim tablo([Tableau1].Rows.Count, 10)
    With FDep
        .[A1].AutoFilter 9, "30"
        Lig = 0
        For N = 2 To [Tableau1].Rows.Count
            If .Cells(N, "A").Rows.Hidden = False Then
                For i = 1 To 9
                    tablo(Lig, i - 1) = .Cells(N, i)
                Next i
                Lig = Lig + 1
            End If
        Next N
    End With
        ReDim tabloR(29) 'vider tabloR
        For a = 1 To UBound(tablo) Step 1          '10 noms par fois
          If tablo(a, 1) <> "" Then                 ' si array colonne 1 est vide on ne fait rien

            ' Mettre ici le code pour filtrer'
            
          End If

          Farr.Range("B33").Resize(UBound(tabloR), UBound(tabloR, 2)) = tabloR  ' Vous collez 4 colonnes ?
          Farr.Range("C40") = "MONTANT"
          Farr.Range("C42") = "30"

    Next
Application.ScreenUpdating = False
End Sub

Essayez de tester sans la dernière partie, avec votre filtre. tant que ça ça ne marche pas inutile d'aller plus loin.

thespeedy20 · 21 Juin 2022

Re,

VB:

Sub DCI()

     Dim a As Integer
     Dim tabloR(), tablo
     Dim FDep  As Worksheet: Set FDep = Worksheets("Données")
     Dim Farr  As Worksheet: Set Farr = Worksheets("Débition_Caution_Ind")
     Dim ws  As Worksheet
     Dim LR1 As Long, LR2 As Long
     Dim sTableau As String
     Dim loTableau As ListObject
    
    Application.ScreenUpdating = False
    
      
    ReDim tablo([Tableau1].Rows.Count, 10)
          
      
    With FDep
        .[A1].AutoFilter 9, "30"
        Lig = 0
        For N = 1 To [Tableau1].Rows.Count
            If .Cells(N, "A").Rows.Hidden = False Then
                For I = 1 To 9
                    tablo(Lig, I - 1) = .Cells(N, I)
                Next I
                Lig = Lig + 1
            End If
        Next N
    End With
    
     ReDim tabloR(29, 1 To 4)
     For a = 1 To UBound(tablo)
          'vider tabloR
          
               If a > UBound(tablo) Then Exit For
               If tablo(a, 0) <> "" Then
              
               r = 0
               tabloR(r, 1) = tablo(a, 0) & " " & tablo(a, 1)
               tabloR(r + 2, 1) = tablo(a, 2)
               tabloR(r + 4, 1) = tablo(a, 3) & " à " & tablo(a, 4) & " " & tablo(a, 5)
              
          

               Farr.Range("B33").Resize(UBound(tabloR), UBound(tabloR, 2)) = tabloR
               Farr.Range("C40") = "MONTANT"
               Farr.Range("C42") = "30"
               Farr.Range("A52") = "X"
               Else
    
               Sautdepage
              
               sTableau = "Tableau1"
               Set loTableau = FDep.ListObjects(sTableau)
 
               loTableau.AutoFilter.ShowAllData
              
                              
              
               Exit Sub
          
          
              
               End If
              
                 
    

For Each ws In ActiveWorkbook.Worksheets
   If ws.Name <> "Données" And ws.Name <> "DCI" And ws.Name <> "DLI" And ws.Name <> "Débition_Location_Ind" Then
        LR1 = Sheets("DCI").Range("A" & Rows.Count).End(xlUp).Row
        LR2 = ws.Range("A" & Rows.Count).End(xlUp).Row
        ws.Range("A1:G" & LR2).Copy Destination:=Sheets("DCI").Range("A" & LR1 + 1)
        
   End If
Next ws


Application.CutCopyMode = False

 
     Next
 
Application.ScreenUpdating = False
End Sub

Ce code fonctionne avec ReDim tabloR(29, 1 To 4)...

J'ai essayé avec ReDim tabloR(29), je ne suis jamais arrivé à le faire fonctionner, j'avais un problème sur cette ligne : Farr.Range("B33").Resize(UBound(tabloR), UBound(tabloR, 2)) = tabloR

OLi

sylvanu · 21 Juin 2022

Farr.Range("B33").Resize(UBound(tabloR), UBound(tabloR, 2)) = tabloR
C'est le transfert d'un tablo à plusieurs dimensions: UBound(tabloR) et UBound(tabloR, 2)
Pour un tableau à une dimension faites :

VB:

Farr.Range("B33").Resize(UBound(tabloR), 1).Value = Application.Transpose(tabloR)

Mais en fait, vous ne répondez jamais aux questions. Donc on n'avancera pas.
Donc c'est inutile de continuer.

thespeedy20 · 21 Juin 2022

re,

sylvanu à dit:
1- Comme dit au post #4 :
Ca n'a pas changé. Je ne comprends toujours pas.

J'ai repris l'idée d'une macro que j'ai trouvé sur le net afin de tester les tableaux, et je n'en sais pas plus malheureusement...

sylvanu à dit:
2- Avez vous modifié le point concernant les ET en OU du post #4.

si je change les ET en OU, les résultats sont totalement différents...ils collent les données des autres feuilles...

sylvanu à dit:
3- dans votre fichier vous faites :

VB:

For a = 1 To UBound(tablo) Step 1 '10 noms par fois ReDim tabloR(29, 1 To 4) 'vider tabloR

donc vous réinitialisez votre array à chaque tour de a.
Ne devrait on pas avoir plutôt :

Code:

ReDim tabloR(29, 1 To 4) 'vider tabloR For a = 1 To UBound(tablo) Step 1 '10 noms par fois

où il n'est initialisé qu'au départ.

j'ai effectué le changement et c'est vrai que c'est plus logique.

je vais essayer de répondre aux questions avec le plus de précisions possibles.

OLi

sylvanu · 21 Juin 2022

Re,

thespeedy20 à dit:
si je change les ET en OU, les résultats sont totalement différents...ils collent les données des autres feuilles...

Oui j'ai dit une sottise. Simple réflexe de Pavlov.
Habituellement je fais :

VB:

If ws.Name = "Données" Or ws.Name = "DCI" Or ws.Name = "DLI" Then

Mais c'est exacetement la même chose que :

Code:

If ws.Name <> "Données" And ws.Name <> "DCI" And ws.Name <> "DLI" Then

Deux points que je ne comprends pas :

1- Cette partie de votre code :

Code:

If a > UBound(tablo) Then Exit For
If tablo(a, 0) <> "" Then
r = 0
tabloR(r, 1) = tablo(a, 0) & " " & tablo(a, 1)
tabloR(r + 2, 1) = tablo(a, 2)
tabloR(r + 4, 1) = tablo(a, 3) & " à " & tablo(a, 4) & " " & tablo(a, 5)

Qu'est ce que c'est censé faire ?
D'autant qu'à chaque boucle vous faites r=0 donc vous ne remplissez que tabloR(0,1), (2,1) et (4,1).
( si même r évoluait, vous n'écrieriez qu'une ligne sur 2 dans l'array. Pourquoi ? )
Ensuite votre :

Code:

Farr.Range("B33").Resize(UBound(tabloR), UBound(tabloR, 2)) = tabloR

va coller ses valeurs en B33:E62 ( 62=33+29 )
Or, dans cette zone vous avez des informations. Vous allez tout détruire.
Un coller array colle TOUT l'array, et non pas seulement les case utilisées.
Donc il va faire du genre : Range("B33:R62)=tabloR.
Et là je ne comprend plus.

thespeedy20 · 21 Juin 2022

re,

sylvanu à dit:
1- Cette partie de votre code :

Code:

If a > UBound(tablo) Then Exit For If tablo(a, 0) <> "" Then r = 0 tabloR(r, 1) = tablo(a, 0) & " " & tablo(a, 1) tabloR(r + 2, 1) = tablo(a, 2) tabloR(r + 4, 1) = tablo(a, 3) & " à " & tablo(a, 4) & " " & tablo(a, 5)

Qu'est ce que c'est censé faire ?

Le but, c'était de prendre les données filtrées, et les insérés dans une feuille et répéter l'opération autant de fois que de données...

Les données sur chaque feuille doivent se trouver

En B33 : nom + prénom
En B35 : date de naissance
En B37 : adresse + code postal + localité

Voilà pourquoi, écrire une ligne sur deux...

Chaque feuille étant collée l'une à la suite de l'autre...

le filtre peut-être appliquer sur la location ou la caution...

OLi

sylvanu · 22 Juin 2022

Bonjour,
En PJ un essai, et vous verrez que ça ne peut pas marcher.
1- On ne remplit que de B33 à B37, dans ce cas on boucle tant que tablo(x,1)<>"" mais on ne tranefère évidemment que le dernier visible
2- On remplit tabloR avec toutes les données visibles et alors le tableau fait ici 18 lignes ( 3*6 ) et alors le collage se fait de B33 à B49. Dans ce cas ce n'est plus compatible de Débition_Caution_Ind
La PJ1 traite le cas 1. La PJ2 le cas 2.
Vous verrez que dans les deux cas il y a un souci.
( NB J'ai supprimé la fin de la macro car elle est en dehors du problème )

thespeedy20 · 22 Juin 2022

Bonjour Sylvanu,

oui effectivement , dans les cas il y a un soucis...

Est-il possible alors de contourner ces problèmes et d'arriver à ce que je désirais faire...?

Autre méthode, autre approche ... ?

OLi

sylvanu · 22 Juin 2022

Bonjour,
C'est impressionnant. Deux fois je vous ai demandé ce que vous vouliez faire, je n'ai pas eu de réponse claire, et vous me demandez s'il existe une autre solution pour résoudre votre problème.
Soyons clair, si vous pouviez répondre clairement aux questions :
Dans votre fichier vous avez trois lignes visibles, ce qui génèrent 18 lignes dans TabloR.
Que voulez vous faire de ces 18 lignes ?
Dans votre code, pour le For each, si vous excluez "Données" ,"DCI", et "DLI" il ne vous reste que Débition_Caution_Ind, où justement on vient de coller.
Désolé j'y comprends vraiment rien.
Alors mettez vos idées au clair sinon ça ne sert à rien de continuer.

thespeedy20 · 22 Juin 2022

re,

Je suis sincèrement désolé, je vais essayer de m'exprimer plus clairement...

Le but est de transférer nom - prénom - date de naissance et adresse complète sur le Débition_Caution_Ind de la façon suivante :

En B33 : nom + prénom
En B35 : date de naissance
En B37 : adresse + code postal + localité

Ce qui représente 6 lignes...

A chaque nouveau nom, nouvelle feuille ! une feuille unique par personne ! donc ici dans l'exemple, il doit générer 3 feuilles.(qui peut-être variable en fonction du filtre)

Ensuite coller l'ensemble des feuilles l'une derrière l'autre dans l'onglet DCI

OLi

sylvanu · 22 Juin 2022

thespeedy20 à dit:
A chaque nouveau nom, nouvelle feuille ! une feuille unique par personne !

Ca, fallait le comprendre.
Alors à quoi sert donc votre "For Each ws In ActiveWorkbook.Worksheets" puisque vous collez dans DCI ?

Pour trois valeurs à coller, il est plus rapide de coller directement dans la feuille plutôt que de créer un TabloR , le rempli, puis le transférer.

Un essai en PJ. Chaque ligne visible remplit une feuille Débition_Caution_Ind qui est copiée à la queue leuleu dans DCI.

thespeedy20 · 22 Juin 2022

re,

c'est exactement ce que je désirais... mille et une excuses pour mon manque de clarté...
Merci beaucoup Sylvanu

Ps : j'ai du remplacer Set Plage = Farr.[A1.G52] par Set Plage = Farr.[A1:G52] car j'avais une erreur d'incompatibilité...

sylvanu · 22 Juin 2022

thespeedy20 à dit:
j'ai du remplacer Set Plage = Farr.[A1.G52] par Set Plage = Farr.[A1:G52]

C'est bizarre, ça passe chez moi, alors qu'effectivement il devrait trouver une erreur.
Le principal est qu'on ait convergé.

ChTi160 · 22 Juin 2022

Bonsoir le fil
C'est peut être du au fait que tu as un point au lieu de 2 pour la définition de la plage (erreur)
Soit :
Farr.[A1.G52] ici un point
Faut
Farr.[A1:G52] la deux points
Jean marie

sylvanu · 22 Juin 2022

Bonsoir Chti,
Ca j'ai compris. Mais sur mon PC avec un point je n'ai pas d'erreur et tout se déroule bien.
Ca, je ne comprend pas.

XL 2019 Utiliser lignes d'un filtre d'un tableau structuré dans un tableau

thespeedy20

XLDnaute Occasionnel

Pièces jointes

sylvanu

sylvanu

XLDnaute Barbatruc

thespeedy20

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

thespeedy20

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

thespeedy20

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

Pièces jointes

thespeedy20

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

thespeedy20

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

Pièces jointes

thespeedy20

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Discussions similaires