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 · 20 Juin 2022

Bonjour thespeedy20,
Sans aller plus avant, la ligne :

VB:

For Compteur = 0 To 0

ne va pas faire grand chose.

thespeedy20 · 20 Juin 2022

Bonjour Sylvanu,

Oui , juste..., je viens de l'enlever mais je n'ai toujours que la première ligne de mon filtre qui active

sylvanu · 20 Juin 2022

Re,
En fait tablo est vide.
J'ai remplit Tableau1 avec :

VB:

    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

"tablo" est remplit des données des lignes visibles.
Il faudra pour TabloR juste vérifier que If tablo(N, 0) <> "" Then ...

Ensuite je n'ai rien compris du remplissage de TabloR.
Si vous le dimensionner à 29 lignes, alors le collage se fera sur 29 lignes. Au vu de la feuille où s'est coller, je ne pense pas que cela soit correct.

Dernier point qui n'a rien à voir :

Code:

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

ne peut pas marcher car une feuille ne peut pas s'appeler Nom1 ET Nom2 ET Nom3.
Tentez plutôt :

Code:

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

on ne travaille que sur les feuilles qui s'appelent Nom1 OU Nom2 OU Nom3

thespeedy20 · 20 Juin 2022

re, Sylvanu

merci pour ton code :

pour le remplissage "Tablo" , j'ai une erreur incompatibilité de type (erreur 13) sur la ligne :

VB:

tablo(Lig, I - 1) = .Cells(N, I)

le but c'est de créer une feuille (Débition_Caution_ind) par ligne de la base filtrée Données et les copiés dans une autre feuille (DCI), les unes à la suite des autres....
J 'espère que c'est plus clair pour toi ce que j'essaie de faire...

OLi

sylvanu · 20 Juin 2022

Oups,
J'ai oublié de copier une ligne, celle qui dimensionne tablo :

VB:

    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

thespeedy20 · 20 Juin 2022

re,

ce n'est pas grave...

Par contre, je ne n'ai pas le résultat voulu...j'ai toujours une vingtaine de feuilles qui se créent... et la première ligne du filtre n'est pas reprise à la sortie...(j'ai changé N = 2 par N=1 et là j'ai première ligne)

Je suis complètement perdu là...

OLi

sylvanu · 20 Juin 2022

Avez vous bien utilisé un IF pour filtre tablo ? comme dit au post #4 :

Il faudra pour TabloR juste vérifier que If tablo(N, 0) <> "" Then ...

car tablo est initialisé avec une longueur égale au tableau de la feuille.
Mais seules les lignes dont tablo(N, 0) <> "" sont visibles, il faut donc s'arrêter dès que tablo(N, 0) = "".
( NB on peut réduire la taille du tablo avec ReDim tablo([Tableau1].Rows.Count, 8)
Ne pas oublier que le tablo commence en 0,0.
Voilà ce que cela donne avec votre fichier :

thespeedy20 · 20 Juin 2022

re,

Non car je ne sais pas ou je dois le mettre. Je découvre les tableaux, là c'est galère pour moi...

Je dois boucler comme ceci ?

VB:

For N = 0 To [Tableau1].Rows.Count
   If tablo(N, 0) <> "" Then

OLi

thespeedy20 · 20 Juin 2022

re,

comme ceci :

VB:

For a = 1 To UBound(tablo) 
          ReDim tabloR(29, 1 To 4)
          '
               If a > UBound(tablo) Then Exit For
               If tablo(a, 0) <> "" Then
                                    
               r = 2
               tabloR(r, 1) = tablo(a, 1) & " " & tablo(a, 2)
               tabloR(r + 2, 1) = tablo(a, 3)
               tabloR(r + 4, 1) = tablo(a, 4) & " à " & tablo(a, 5) & " " & tablo(a, 6)
              
               Farr.Range("B33").Resize(UBound(tabloR), UBound(tabloR, 2)) = tabloR
               Farr.Range("C40") = "MONTANT"
               Farr.Range("C42") = "30"
    
    
               Else
    
               Exit Sub
          
          
            
              End If

sylvanu · 20 Juin 2022

Regardez le post 6,c'est clair.
Il est à mettre avant le with.
Là où vous l'avez mis il est réinitialisé à chaque boucle.

thespeedy20 · 20 Juin 2022

Merci beaucoup pour ton aide et ta patience Sylvanu...

Juste une chose comment obtiens tu le résultat du post 8

@+

Oli

Deadpool_CC · 20 Juin 2022

Bonjour,

en console vba : tu exécutes ta macro en "pas-à-pas" (F8) et tu ajoutes un espion sur ton objet "tablo"
tu verra l'espion qui te donne les valeurs au fur et à mesure du remplissage
A+

thespeedy20 · 20 Juin 2022

Bonjour Deadpool_CC,

merci pour l'astuce...

A+

OLi

thespeedy20 · 21 Juin 2022

Bonjour Sylvanu,

sylvanu à dit:
Regardez le post 6,c'est clair.
Il est à mettre avant le with.
Là où vous l'avez mis il est réinitialisé à chaque boucle.

je ne vois pas comment m'y prendre...quelle boucle utilisée.. , le end if et le next...en un mot je galère....

Merci encore une fois pour ton aide

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

thespeedy20

XLDnaute Occasionnel

thespeedy20

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

thespeedy20

XLDnaute Occasionnel

Deadpool_CC

XLDnaute Accro

thespeedy20

XLDnaute Occasionnel

thespeedy20

XLDnaute Occasionnel

Discussions similaires