Pb de boucle sur export tableau filtré (for each next)

  • Initiateur de la discussion Initiateur de la discussion zebanx
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

zebanx

XLDnaute Accro
Bonjour à tous.

Pourriez-vous SVP m'aider dans la modification d'un code permettant d'exporter des range filtrés sur une feuille tampon ?
Cette export (temporaire) m'est utile pour un envoi de ce range à différentes personnes par outlook.

En gros, on exporte de la base contact temporairement sur la feuille "envoi" la partie du tableau qui concerne un contact (filtre sur colonne A dans la feuille "contacts") et un autre code permet de lancer outlook. Et ainsi de suite...

Partant d'un code de déconsolidation classique (et qui fonctionne)*, il y a un problème dans la boucle dès le deuxième passage.

Vous en remerciant par avance, bonne journée
zebanx

VB:
Sub Tri_filtres()
Dim Plage, Code, C As Range
Application.ScreenUpdating = False

With Sheets("contacts")
  If .FilterMode Then .ShowAllData
  Set Plage = .Range("A1:G" & .Cells(Rows.Count, "A").End(xlUp).Row)
  Set Code = .Range("A2:G" & .Cells(Rows.Count, "A").End(xlUp).Row)

  For Each C In Code
    Plage.AutoFilter Field:=1, Criteria1:=C
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("envoi").Range("a2:g1000").ClearContents
    Application.DisplayAlerts = True
    On Error GoTo 0
    Plage.SpecialCells(xlCellTypeVisible).Copy Sheets("envoi").[a1]
  Next
End With

Application.ScreenUpdating = True
End Sub

* code sur fil :
'https://www.excel-downloads.com/threads/création-automatique-donglet-sur-une-base-de-travail.20018027/#post-20131568
 

Pièces jointes

Bonjour,

Souci 1:
on veut filtrer Plage selon chaque cellule de Code (A2:Gxx) .
Itération 1 :la première cellule de Code(A2)= a001, filtrage OK
Itération 2 : la seconde cellule de Code(B2)= noma, filtrage NOK
il faudrait Set Code = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row)

Mais, souci 2:
Itération 1 :la première cellule de Code(A2)= a001, filtrage OK
Itération 2 : la seconde cellule de Code(A3)= a001, filtrage OK mais deuxième filtre avec le même critére
Itération 3 : la troisième cellule de Code(A4)= a001, filtrage OK mais troisième filtre avec le même critére
à moins que ce soit un jeu d'essai non représentatif du réel.

Souci 3:
le contact est en colonne E et non A ?

A+
 
Bonjour Paf,

Merci.
Effectivement, ça fonctionne déjà mieux avec un export par code possible suite à ta remarque.

Les fichiers sont envoyés à une personne qui a 1 ou plusieurs contacts, la référence de l'envoi pour moi reste la colonne A. Après, à cette personne de contacter ses cibles (colonne E).

Il reste effectivement le problème de code "unique" pour chaque valeur filtrée, je vais essayer de regarder cela car là le code m'envoie à la même personne (colonne A) plusieurs fois le tableau par outlook.
Encore un peu de boulot en perspective -)

@+
zebanx
 
pour le code unique, on peut utiliser un dictionary:


VB:
Dim Dico, CC as Range
Set Dico = CreateObject("Scripting.Dictionary")
.../...
  For Each CC In Code
  Dico(CC.Value) = ""
  Next
  For Each Clé In Dico.keys
  Plage.AutoFilter Field:=1, Criteria1:=Clé
  Sheets("envoi").Range("a2:g1000").ClearContents
  Plage.SpecialCells(xlCellTypeVisible).Copy Sheets("envoi").[a1]
  Next
.../...
 
Re-

Merci pour ta réponse et je viens de trouver, dans l'intervalle, une autre alternative fonctionnelle sans dictionnaire.

J'appelle une autre procédure ("mailto") pour l'envoi des différents tableaux mais ça fonctionne comme souhaité (un tableau par destinataire colonne A).

Toutefois, l'utilisation du dictionnaire pourrait être utile même si pour ce cas la plage n'est pas très grande (pas toute la base mais elle représente moins de 1000 lignes).
Et après essai ton code fonctionne parfaitement bien et est plus simple à utiliser même. Merci !

@+
zebanx

VB:
Sub Tri_filtres()
Dim Plage, Code, C As Range
Application.ScreenUpdating = False

With Sheets("contacts")
  If .FilterMode Then .ShowAllData
  Set Plage = .Range("A1:G" & .Cells(Rows.Count, "A").End(xlUp).Row)
  Set Code = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row)

derligne = Sheets("contacts").Cells(Rows.Count, 1).End(3).Row
n = 1

For Each C In Code
   '---copie si premier passage ou non doublon
   If n = 1 Then
   Sheets("envoi").Range("a2:g1000").ClearContents
   Plage.AutoFilter Field:=1, Criteria1:=C
   Plage.SpecialCells(xlCellTypeVisible).Copy Sheets("envoi").[a1]
   Call mailto '---autre procédure pour envoi tableau filtré par outlook
   End If
   '--- compare la valeur de la ligne du dessous pour incrémenter ou pas
   If Sheets("contacts").Cells(C.Row + 1, 1).Value = C Then
   n = n + 1
   Else
   n = 1
   End If
Next
End With

Application.ScreenUpdating = True
End Sub
 

Pièces jointes

Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
481
Réponses
4
Affichages
332
Réponses
3
Affichages
518
Retour