Macro Filtrer-imprimer

[redba]

Bonjour, je cherche à créer une macro qui me permet de :

1. Filtrer sur la colonne B critère première valeur
2. Sélection la zone d'impression du filtre
3. Imprimer la sélection
4. recommencer les mêmes étapes pour la seconde valeur et ainsi de suite
5. s'arrêter si la colonne B est vide

Ci-joint un petit fichier
Merci pour votre aide

PS: j'ai cherché par moi même mais je ne trouve rien qui me convient vraiment

 

[JBOBO]

Re : Macro Filtrer-imprimer

Bonjour,

Je pense que l'enregistreur de macro doit pouvoir faire l'affaire.

 

[redba]

Re : Macro Filtrer-imprimer

Tout d'abord merci,

mais j'ai essayé et les soucis sont les suivants:

plusieurs clients possibles le nombre de lignes et inconnu etc....

pour la zone d'impression c'est pas grave on va oublier par contre ma formule sera de la forme suivante :

Dim i As Integer
For i = 3 To 'l'idéal est illimité'
Selection.AutoFilter Field:=1, Criteria1:='je n'arrive pas à indiquer une plaage de cellule d'une autre feuille' ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Next i
'je n'arrive pas non plus a faire en sorte que la macro s'arrete a la premeier cellule vide'

voila merci

 

[redba]

Re : Macro Filtrer-imprimer

Bon j'ai un peu avancé

" Dim i As Integer
For i = 3 To xxx

Selection.AutoFilter Field:=1, Criteria1:=Sheets("liste clients").Cells(i, 2).Value
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Next i"

Par contre je ne suis rendu compte que :
1 si ma liste clients contient des cellules vide la macrto tri et imprimer les cellule vide or je voudrais qu'elle s'arrete.
2 si mon fichier ne contient pas le clients le tri se fait aussi avec la valeur NA

j'ai essayé:

Dim i, j As Integer
For i = 3 To 5
For j = 10 To 15
If Sheets("liste CLIENT").Cells(i, 2) <> Sheets("liste").Cells(j, 2) Then
Selection.AutoFilter Field:=1, Criteria1:=Sheets("liste CLIENT").Cells(i + 1, 2).Value
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Else
Selection.AutoFilter Field:=1, Criteria1:=Sheets("liste CLIENT").Cells(i, 2).Value
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
Next j
Next i
End Sub

MAIS cela ne marche pas merci a vous

 

[nat54]

Re : Macro Filtrer-imprimer

Bonjour,

Cette macro que j'avais réalisée grâce au forum XLD peut peut-être t'aider

[FONT=Wingdings][SIZE=3]§[/SIZE]         [/FONT][B][FONT=Arial][SIZE=3]Macro 1 : créer les onglets d’un fichier à partir d’un filtre automatique[/SIZE][/FONT][/B]
[FONT=Arial]Sub Créer_objectifs_CC()[/FONT]
 
[FONT=Arial]Application.ScreenUpdating = False  [/FONT][SIZE=2][COLOR=teal][FONT=Arial]'ne pas voir ce qui se passe à l'écran, diminue besoin mémoire[/FONT][/COLOR][/SIZE]
 
[FONT=Arial]For lgn = 2 To 24   [/FONT][SIZE=2][COLOR=teal][FONT=Arial]'pour boucler sur les lignes 2 à 24[/FONT][/COLOR][/SIZE]
 
[FONT=Arial]Sheets("Ref").Select   [/FONT][SIZE=2][COLOR=teal][FONT=Arial]'on se place sur la feuille de référence[/FONT][/COLOR][/SIZE]
[FONT=Arial]indic = Cells(lgn, 1).Value   [/FONT][SIZE=2][COLOR=teal][FONT=Arial]'on variabilise, indic = cellule ligne de la boucle, colonne 1[/FONT][/COLOR][/SIZE]
[FONT=Arial]Sheets("Recap Objectif CC").Select   [/FONT][SIZE=2][COLOR=teal][FONT=Arial]''on se place sur la feuille où se trouve la BD[/FONT][/COLOR][/SIZE]
 
[FONT=Arial]Range("e1").Select   [COLOR=teal]'[/COLOR][/FONT][SIZE=2][COLOR=teal][FONT=Arial]on choisit un indicateur dans filtre automatique[/FONT][/COLOR][/SIZE]
[FONT=Arial]Selection.AutoFilter[/FONT]
[FONT=Arial]Selection.AutoFilter Field:=5, Criteria1:=indic [COLOR=green]‘ [/COLOR][/FONT][SIZE=2][COLOR=green][FONT=Arial]l’indicateur[/FONT][/COLOR][COLOR=teal][FONT=Arial] se trouve en colonne 5[/FONT][/COLOR][/SIZE]
 
[FONT=Arial]Range("A1:R1500").Select[/FONT]
[FONT=Arial]  Range("R1500").Activate[/FONT]
[FONT=Arial]  Selection.Copy[/FONT]
 
 
[FONT=Arial]Sheets.Add After:=Worksheets(Worksheets.Count)     [/FONT][COLOR=teal][FONT=Arial][SIZE=2]'on ajoute un onglet après les[/SIZE][/FONT][/COLOR][COLOR=teal][FONT=Arial] 2 [/FONT][/COLOR][SIZE=2][COLOR=teal][FONT=Arial]premières[/FONT][/COLOR][FONT=Arial] [COLOR=green]feuilles[/COLOR][/FONT][/SIZE]
[FONT=Arial]ActiveSheet.Name = indic    [/FONT][SIZE=2][COLOR=teal][FONT=Arial]'on nomme l'onglet comme nom indicateur[/FONT][/COLOR][/SIZE]
 
[FONT=Arial]Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _[/FONT]
[FONT=Arial]False, Transpose:=False   [COLOR=teal]' on colle[/COLOR][/FONT]
 
[FONT=Arial][E9] = "Somme" [/FONT][SIZE=2][FONT=Arial][COLOR=teal]‘facultatif : possibilité de faire total de chaque colonne sur chaque feuille[/COLOR][/FONT][/SIZE]
[FONT=Arial]Range("F9").Select[/FONT]
[FONT=Arial]ActiveCell.FormulaR1C1 = "=IF(COUNT(R[-7]C:R[-2]C)=0,"""",SUM(R[-7]C:R[-2]C))"[/FONT]
[FONT=Arial]Range("F9").Select[/FONT]
[FONT=Arial]Selection.AutoFill Destination:=Range("F9:Q9"), Type:=xlFillDefault[/FONT]
[FONT=Arial]Range("F9:Q9").Select[/FONT]
[FONT=Arial]ActiveWindow.ScrollColumn = 1[/FONT]
[FONT=Arial]Range("E9").Select[/FONT]
 
[FONT=Arial]Next lgn   [/FONT][SIZE=2][COLOR=teal][FONT=Arial]' on continue sur 2nd, 3èm.. [/FONT][/COLOR][COLOR=teal][FONT=Arial]indicateur (boucle)[/FONT][/COLOR][/SIZE]
 
[FONT=Arial]Application.ScreenUpdating = True[/FONT]
 
[FONT=Arial]End Sub[/FONT]

 

[redba]

Re : Macro Filtrer-imprimer

Bon merci de votre aide,
j'ai trouvé une solution



Application.ScreenUpdating = False 'Merci Nat

Dim i As Integer
For i = 10 To Cells(1, 3) 'je reste sur mon i qui va varier. la valeur limite de ligne et en C1 avec une simple formule nb.si


If Cells(i, 2).Value = Cells(i - 1, 2).Value Then 'si iémé cellule de la colonne B est égal à la précédente on passe à la suiteCells(i + 1, 2).Select
Else 'Sinon on imprime
Selection.AutoFilter Field:=1, Criteria1:=Cells(i, 2)
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
Next i

Bon pour la zone d'impression c'est pas grave je la détermine juste avant l'impression on vera pour la formule quand j'aurai le temps

 

[redba]

Re : Macro Filtrer-imprimer

Voila pour la zone d'impression

ActiveSheet.PageSetup.PrintArea = Range("C1:N" & _
Range("C65536").End(xlUp).Row).Address