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

thespeedy20

XLDnaute Occasionnel
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
 

Pièces jointes

  • Avis_copie_V2B_individuel.xlsm
    42.2 KB · Affichages: 25
Solution
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

XLDnaute Occasionnel
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
 

Pièces jointes

  • Avis_copie_V2B_individuel (V2).xlsm
    129.3 KB · Affichages: 4

sylvanu

XLDnaute Barbatruc
Supporter XLD
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 :
1656148519647.png

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.
 

Discussions similaires

Réponses
11
Affichages
236

Statistiques des forums

Discussions
311 725
Messages
2 081 943
Membres
101 849
dernier inscrit
florentMIG