Boucle dans boucle

[lepigoennier]

Bonjour le forum,

Je dois faire 2 boucles imbriquées. La première est pour sélectionner tous les items d'une liste et les mettre dans le filtre. Par la suite, je copie le résultat et je dois recopier avec transposition pour chacun des fournisseur sur une autre page. Voici mon code jusqu'à présent. LE résultat, est que ça copie tout sur la première ligne. Est-ce que vous pouvez m'aider?

Merci

Sub Macro2()
'
'Filtrer pour les items dont nous n'avons pas le certificat

selection.AutoFilter
ActiveSheet.Range("$A$1:$R$8205").AutoFilter Field:=6, Criteria1:="."

Dim Collec As New Collection
Dim Cell As Range, Itm As Long
With Sheets("Courriel")
For Each Cell In .Range("B2:B" & .Range("C65536").End(xlUp).Row)
On Error Resume Next
Collec.Add Cell, CStr(Cell)
On Error GoTo 0
Next
For Itm = 1 To Collec.Count
Sheets("Données").Select
selection.AutoFilter Field:=8, Criteria1:=Collec.Item(Itm)
Range("C1:C8220").Select
Application.CutCopyMode = False
selection.Copy
Sheets("Courriel").Select
Range("C2").Select 'ici je dois faire une boucle pour mettre les items pour chacun des fournisseurs de la feuille Données

' Coller avec transpose pour passer de colonne à ligne

selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Next
End With
End Sub

 

[Herdet]

Re : Boucle dans boucle

Bonjour,
Je pense que tu dois pouvoir solutionner ton problème sans macros avec un simple TCD.
Dans la zone des Valeurs du TCD, adapter les champs de sommes formatés ( items de ton fichier ???? )

Ci-joint le fichier complété.

Cordialement
Robert

 

[lepigoennier]

Re : Boucle dans boucle

Je te remercie, mais ce n'est pas ce que je voulais. Les données vont servir à faire un publipostage. J'ai solutionnée le problème.

 

[mapomme]

Re : Boucle dans boucle

Bonjour lepigoennier,

Et pour tous ceux (dont mapomme) qui ont travaillé sur votre demande, quelle est la solution ?

 

[Herdet]

Re : Boucle dans boucle

Bonjour lepigoennier,

Et pour tous ceux (dont mapomme) qui ont travaillé sur votre demande, quelle est la solution ?

Bonjour,
Bon, ce n'est pas grave car de toutes façons on a aucune info sur ce qu'il appelle les Items à extraire de la base.
"'ici je dois faire une boucle pour mettre les items pour chacun des fournisseurs de la feuille Données"
Comprenne qui pourra !

Par satisfaction personnelle, j'ai quand même fignolé une solution VBA en 20 lignes avec une seule boucle !

A+
Robert

 

[lepigoennier]

Re : Boucle dans boucle

Voici la solution

Dim Collec As New Collection
Dim Cell As Range, Itm As Long
With Sheets("Courriel")
For Each Cell In .Range("B2:B" & .Range("C65536").End(xlUp).Row)
On Error Resume Next
Collec.Add Cell, CStr(Cell)
On Error GoTo 0
Next
For Itm = 1 To Collec.Count
Sheets("Données").Select
Selection.AutoFilter Field:=8, Criteria1:=Collec.Item(Itm)
Range("C1:C8220").Select
Application.CutCopyMode = False
Selection.Copy
With Sheets("Courriel")
.Range("E65536").End(xlUp)(2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End With
Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Next
End With

 

[mapomme]

Re : Boucle dans boucle

(Re)Bonsoir lepigoennier

Merci d'avoir posté ta solution .

@+

 

[Herdet]

Re : Boucle dans boucle

Voici la solution

OK, mais il y à quelques petites erreurs, voir code ci-après
Si cela t' intéresse, je t'envoie ci-jointe ma version de la procédure,... à adapter.
Salutations

Sub Nouvelle_macro_de_lepigeonnier()

   Dim Collec As New Collection
   Dim Cell As Range, Itm As Long
   Sheets("Données").Select
   selection.AutoFilter
    ActiveSheet.Range("$A$1:$R$8205").AutoFilter Field:=6, Criteria1:="."
    
   With Sheets("Courriel")
   'For Each Cell In .Range("B2:B" & .Range("C65536").End(xlUp).Row)
   For Each Cell In .Range("B2:B" & .Range("B65536").End(xlUp).Row)
      On Error Resume Next
      Collec.Add Cell, CStr(Cell)
      On Error GoTo 0
   Next
   For Itm = 1 To Collec.Count
      Sheets("Données").Select
      Debug.Print Collec.Item(Itm)
      selection.AutoFilter Field:=8, Criteria1:=Collec.Item(Itm)
      
      '  Range("C2:C8220").Select   'et pas: Range("C1:C8220").Select
      ' PROBLEME : avec selection.Copy tous les formats conditionnels des 8220 lignes
      '             sont aussi transférés dans 8220 colonnes de Courriel
      '  selection.Copy
      ' il serait préférable d'utiliser
       Range("C2:C8220").SpecialCells(xlCellTypeVisible).Copy

      With Sheets("Courriel")
         '.Range("E65536").End(xlUp)(2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
         .Range("C65536").End(xlUp)(2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
      End With
      'Range("E2").Select
      Range("C2").Select
      selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
   Next
   End With
   Application.CutCopyMode = False
End Sub

 

[lepigoennier]

Re : Boucle dans boucle

Un gros merci à Herdet pour ta macro Publipostage. Elle a réglé tous les bugs que j'avais avec ma macro. À savoir quelle ne mettait pas les bons # d'items au bon fournisseur.