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

 

[ChTi160]

ah ok !
Chez moi erreur 13 !
Bonne fin de Soirée
Jean marie

 

[thespeedy20]

Bonjour à tous,

@sylvanu

J'ai essayé de faire un récap (10 noms par feuille, le modèle est dans fichier) en partant de la dernière macro que tu as écrite, mon soucis c'est qu'il copie 10 x le même nom sur la feuille...et autant de feuille que de nom...
surement un problème de boucle ?

OLi

 

[sylvanu]

Bonjour,
Désolé, je ne comprends rien à votre code.
Si on met un point d'arrêt à Next a, il s'arrête avec a=0, et cela donne :

Evidemment vous recopiez 10 fois la même chose avec For Compteur = 0 To 9.
Comme déjà expliqué, j'ai horreur de faire du code en aveugle.
Jamais un mot d'explications, quand il y en a elles sont incomplètes.
Sorry, je jette l'éponge.

 

[thespeedy20]

Je comprends...Merci, bon we