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

nat54

XLDnaute Barbatruc
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 :confused:

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 :

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 !!!
 

Cousinhub

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

Bonsoir,

un filtre automatique est-il le meilleure solution?

Pour créer un onglet par personne, avec ses données personnelles, le mieux serait de passer par un filtre personnalisé....

Un fichier exemple pourrait t'aider au mieux....
 

nat54

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

Les problèmes :

- il me crée 12 onglets au lieu de 3 (3 chefs différents)

- je n'arrive pas cependant à mettre le bon nom des onglets
il prend le matricule au lieu du nom du chef
 

Pièces jointes

  • test_.xls
    32 KB · Affichages: 265
  • test_.xls
    32 KB · Affichages: 274

nat54

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

Bonjour,

Pourquoi dire "une approche" ? alors que c'est tout à fait ce que je veux

CEPENDANT :D
n'y -a-t"il pas simplement moyen d'adapter mon code, que je comprends ?
car là le vôtre me semble bien complexe pour qqch de simple (qui marchait lors de mon stage)
 

JNP

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

Bonjour le forum :),
J'avoue que ton souci me laisse perplexe :(... En exécutant pas à pas, on s'aperçoit que ta variable nom_onglet prends la valeur 1 au lieu de XXX, alors que pourtant la formulation est bonne... pour contourner le problème, j'ai utilisé une référence directe:
Code:
nom_onglet = Sheets("Liste_des_noms").Cells(lgn, 2).Value
Là, ça marche. Après, ton erreur se produit une fois que tu lit une case vide et que tu veux nommer un onglet en "". J'ai donc rajouté la ligne
Code:
If nom_onglet = "" Then Exit For
en dessous de la la ligne précédente. Cela devrait permettre que tu utilises ton code, même si celui de ChTi160 était très bien, mais je ne peux que t'encourager dans cette voie qui est celle de comprendre et non de prendre. Maintenant si quelqu'un peux m'expliquer la bizarerie que j'ai contourné, je suis preneur :p.
Bonne journée :cool:
 

Cousinhub

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

Bonjour,

salut JNP

comme le code est lancé à partir de l'onglet "Pres°_provisoire",

Code:
nom_onglet = Cells(lgn, 2).Value

prend donc la valeur de la cellule Bx de cet onglet.....
 

nat54

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

Bonjour le forum :),
J'avoue que ton souci me laisse perplexe :(... En exécutant pas à pas, on s'aperçoit que ta variable nom_onglet prends la valeur 1 au lieu de XXX, alors que pourtant la formulation est bonne... pour contourner le problème, j'ai utilisé une référence directe:
Code:
nom_onglet = Sheets("Liste_des_noms").Cells(lgn, 2).Value
Là, ça marche. Après, ton erreur se produit une fois que tu lit une case vide et que tu veux nommer un onglet en "". J'ai donc rajouté la ligne
Code:
If nom_onglet = "" Then Exit For
en dessous de la la ligne précédente. Cela devrait permettre que tu utilises ton code, même si celui de ChTi160 était très bien, mais je ne peux que t'encourager dans cette voie qui est celle de comprendre et non de prendre. Maintenant si quelqu'un peux m'expliquer la bizarerie que j'ai contourné, je suis preneur :p.
Bonne journée :cool:

comme ça ?

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 = Sheets("Liste_des_noms").Cells(lgn, 2).Value
If nom_onglet = "" Then Exit For
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 ne lance rien apparemment...
 

nat54

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

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 = Sheets("Pres°_provisoire").Cells(Lgn, 5).Value
''If nom_onglet = "" Then Exit For
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

Ce code marche bien au 1er passage ca me donne exactement l'onglet voulu
mais au 2nd passage il me remet le même nom de chef et donc plantage
 

ChTi160

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

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

Code:
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
 

nat54

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

Extra ChTi160 !
Merci bien et là je comprends tout à fait le code
Je garde cela dans ma besace car finalement ca ressemble vraiment à mon 1er code. Pas grand-chose n'a été modifié



Juste pour finir sur ce fichier j'ai maintenant les 60 (~) onglets crées
Je voudrais juste sélectionner les 60 onglets et les reformater
J'ai utilisé l'enregistreur de macro qui me donne ça

Code:
Sub Finaliser_Presentation()
    Sheets(Array("XXX", "YYY", "ZZZ")).Select
    Sheets("XXX").Activate
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Range("A4").Select
    Selection.Cut
    Range("C1").Select
    ActiveSheet.Paste
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
End Sub

Comment lui dire (car je ne connaitrais pas à l'avance les noms et le nombre) de prendre tous les nouveaux onglets crées pour appliquer ces formats ?

merci
 
Dernière édition:

bcharef

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

Bonsoir à tous,

Suite à ma méconnaissance absolue de la programmation VBA, et de pouvoir apporter un plus, si je suis dans la possibilité de mesure de répondre à ce probléme, je vous sollicite à le faire par le biais des TCD , en affichant les pages par nom de chef et les feuilles s'afficheront automatiquement, et vous aboutiriez aux mêmes résultats voulues sans passer par une programmation .

Et, si je suis loin de votre probléme, je vous demanderiez mes excuses à l'avance .

Cordialement .
 

Discussions similaires

Réponses
19
Affichages
2 K

Statistiques des forums

Discussions
311 720
Messages
2 081 896
Membres
101 833
dernier inscrit
sandra25