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

[thespeedy20]

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...

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]

Bonjour thespeedy20,
Sans aller plus avant, la ligne :

For Compteur = 0 To 0

ne va pas faire grand chose.

 

[thespeedy20]

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]

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

    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 :

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 :

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]

re, Sylvanu

merci pour ton code :

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

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]

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

    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]

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]

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]

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 ?

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

OLi

 

[thespeedy20]

re,

comme ceci :

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]

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]

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

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

@+

Oli

 

[Deadpool_CC]

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]

Bonjour Deadpool_CC,

merci pour l'astuce...

A+

OLi

 

[thespeedy20]

Bonjour Sylvanu,

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