Créer des onglets à partir d'un filtre automatique

[nat54]

Bonjour,

J'avais déjà réalisé cette manip' il y a 3 ans au cours d'un stage. J'avais conservé mon code, j'essaie donc de l'adapter à mon cas présent et je n'y arrive pas

Le fichier :
- un onglet Pres°_provisoire avec la base de données qui va de A1 à S198
En colonne A : les noms des docteurs
- un onglet Liste_de_noms où j'ai de A1 à A70 la liste des docteurs concernés

Mon code :

Sub une_feuille_par_nom()

Application.ScreenUpdating = False  'ne pas voir ce qui se passe à l'écran, diminue besoin mémoire



For lgn = 2 To 71   'pour boucler sur les lignes 2 à 71

Sheets("Liste_des_noms").Select   'on se place sur la feuille de référence
indic = Cells(lgn, 1).Value    'on variabilise, indic = cellule ligne de la boucle, colonne 1
nom_onglet = Cells(lgn, 10).Value
Sheets("Pres°_provisoire").Select   ''on se place sur la feuille où se trouve la BD

Range("a1").Select   'on choisit un indicateur dans filtre automatique
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:=indic 'l'indicateur se trouve en colonne 1

    Range("A1:S197").Select
    Range("S197").Activate
    Selection.Copy
    


Sheets.Add After:=Worksheets(Worksheets.Count)     'on ajoute un onglet après les 2 premières feuilles
ActiveSheet.Name = nom_onglet    'on nomme l'onglet comme nom indicateur

Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False   ' on colle

Next lgn   ' on continue sur 2nd, 3èm.. indicateur (boucle)

Application.ScreenUpdating = True

End Sub

Ca marche pour le 1er nom mais ensuite j'ai l'impression qu'il veut remettre le même nom (il ne fait pas la boucle sur le bon onglet ?!) et donc plantage car 2 onglets ne peuvent pas porter le même nom

Merci d'avance pour votre aide !!!

 

[nat54]

Re : Créer des onglets à partir d'un filtre automatique

Bonjour,

Je crois que les TCD n'aideront pas au problème car les TCD permettent une agrégation (somme, moyenne..) de données pour un indicateur voulu

Moi je ne veux pas d'agrégation, juste récupérer les infos par chef de service.

Merci quand même.

 

[JNP]

Re : Créer des onglets à partir d'un filtre automatique

Bonjour le forum ,
Désolé, je n'était plus en ligne, mais ChTi160 s'en est sorti comme un chef. Pour traiter tous tes nouveaux onglets, le plus simple est de décrire la collection:

Sub Présentation()
Dim WS As Worksheet
Application.ScreenUpdating = False
    For Each WS In ThisWorkbook.Worksheets
        If WS.Name <> "Pres°_provisoire" And WS.Name <> "Liste_des_noms" Then
       [COLOR=seagreen]     ' Là tu mets tes codes de présentation[/COLOR]
        End If
    Next
End Sub

Bonne journée

 

[Eve-Line]

Re : Créer des onglets à partir d'un filtre automatique

Bonjour ChTi160

Je suis à la recherche d'une solution similaire, et je viens de tester le code ci-dessous, mais...... Je travaille sur des listes de clients que je voudrais regrouper par district. Pour moi, un district =

Un chef de district avec un numéro de district bien spécifique
entre 10 et 20 vendeurs chacun avec leur numéro bien spécifique
entre 2000 et 3000 clients (donc entre 2000 & 3000 lignes par fichier).

Le code ci-dessous m'a bien fournit un onglet pour le premier numéro de vendeur rencontré, puis j'ai eu un message d'erreur... De ce que je peux voir, le filtre automatique ne passe pas automatiquement à la 2ème valeur (deuxième vendeur par ordre numérique).... Comment faire pour que cela marche?

Merci d'avance pour l'aide précieuse!

Re
Bonjour le fil

j'ai mis en pratique ce que JNP et bhbh ont proposé et qui est la solution je pense aussi Lol

Sub une_feuille_par_nom()
   On Error GoTo une_feuille_par_nom_Error
Application.ScreenUpdating = False  'ne pas voir ce qui se passe à l'écran, diminue besoin mémoire
For lgn = 2 To 71   'pour boucler sur les lignes 2 à 71
With Sheets("Liste_des_noms") [COLOR=SeaGreen]'ici on va travailler sur cette feuille With évite de répéter le nom de la feuille devant chaque point et cela jusqu'au prochain End With[/COLOR]
               [COLOR=Red].[/COLOR]Select   'on se place sur la feuille de référence
     indic = [COLOR=Red].[/COLOR]Cells(lgn, 1).Value    'on variabilise, indic = cellule ligne de la boucle, colonne 1
nom_onglet = [COLOR=Red].[/COLOR]Cells(lgn, 2).Value
End With
If indic = "" Then Exit For [COLOR=SeaGreen]'si cellule vide on quitte la boule[/COLOR]
With Sheets("Pres°_provisoire") [COLOR=SeaGreen]'ici on va travailler sur cette feuille With évite de répéter le nom de la feuille devant chaque point et cela jusqu'au prochain End With[/COLOR]
  [COLOR=Red].[/COLOR]Select   ''on se place sur la feuille où se trouve la BD
  [COLOR=Red].[/COLOR]Range("a1").Select   'on choisit un indicateur dans filtre automatique
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:=indic 'l'indicateur se trouve en colonne 1

    [COLOR=Red].[/COLOR]Range("A1:S197").Select
   [COLOR=Red] .[/COLOR]Range("S197").Activate
End With
    Selection.Copy
  
Sheets.Add After:=Worksheets(Worksheets.Count)     'on ajoute un onglet après les 2 premières feuilles
ActiveSheet.Name = nom_onglet    'on nomme l'onglet comme nom indicateur
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False   ' on colle
Next lgn   ' on continue sur 2nd, 3èm.. indicateur (boucle)
Application.ScreenUpdating = True
   On Error GoTo 0
   Exit Sub
une_feuille_par_nom_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure une_feuille_par_nom of Document VBA Feuil1"
End Sub

on est pas obligé de sélectionner les feuilles "Select"

Bonne journée

 

[ChTi160]

Re : Créer des onglets à partir d'un filtre automatique

Salut Eve-Line
Bonjour le fil
Bonjour le Forum

Pourrais tu mettres un fichier exemple de Ton fichier Source(quelques lignes sans donnees confidentielles) et un exemple de la configration de la feuille districk attendue

Merci d'avance
Bonne journée

 

[Eve-Line]

Re : Créer des onglets à partir d'un filtre automatique

Bonjour Chti160, merci de me répondre. J'ai trouvé un moyen de "contourner" mon problème en effaçant chaque fois la sélection dans mon onglet source ("Sheet1"), mais s'il y avait moyen de faire plus simple....... et aussi j'ai ajouté le formatage dans la macro car ce fichier est destiné à des utilisateurs de niveau très varié. Je veux donc qu'ils puissent imprimer sans rien modifier.....

Note que une fois l'onglet source copié vendeur par vendeur, je n'en ai plus vraiment besoin, y a-t-il moyen d'ajouter une ligne dans la macro pour le deleter?

L'autre soucis que je rencontre, est que mon fichier final fait > 33 MB.... je suppose à cause du format recopié à chaque fois. N'y a-t-il pas moyen de réduire la taille du fichier? Peut être que ma macro est trop chargée? Peut être puis-je ajouter dans la macro une ligne pour sauvegarder sous en stipulant le format afin de réduire la taille du fichier?

Mais je m'éparpille un peu... pour récapituler, je voudrais savoir:

1- Je boucle sur 10000 lignes pour être sûre de tout avoir, mais est-il possible d'utiliser "usedrange" à la place? J'ai essayé mais je n'y arrive pas

2- comment faire pour ne pas finir avec un fichier de > 30 MB?

Encore une fois merci d'avance pour l'aide

 

[Eve-Line]

Re : Créer des onglets à partir d'un filtre automatique

Je boucle sur 10000 lignes pour être sûre de tout avoir, mais est-il possible d'utiliser "usedrange" à la place? J'ai essayé mais je n'y arrive pas

Encore une fois merci d'avance pour l'aide

est-ce que quelqu'un pourrait m'aider à intégrer le concept de "usedrange" dans ma macro?

Merci beaucoup beaucoup beaucoup

 

[ChTi160]

Re : Créer des onglets à partir d'un filtre automatique

Salut Eve-Line
Bonjour le fil
Bonjour le Forum

Arff pas trop le temp ,mais peut être en mettant ceux ci

For lgn = 2 To ActiveSheet.UsedRange.Rows.Count

Bonne fin de Journée

 

[Eve-Line]

Re : Créer des onglets à partir d'un filtre automatique

Merci bien!! je vais tester