création automatique d'onglet dans un classeur

[flo29200]

Bonjour,

J'ai une feuille dans un classeur avec deux colonnes :
- une premiere colonne dans laquelle j'ai des noms d'objet
- une deuxieme colonne dans laquelle j'ai plusieures lignes pour un meme nom d'objet; cela donne :

colonne A colonne B
objet 1 desc 1
objet 1 desc 2
objet 1 desc 3
objet 2 desc 1
objet 2 desc 2
objet 2 desc 3

jes souhaiterais créer de manière automatique autant de feuille dans mon classeur que de nom d'objet et reprendre dans chaque feuille l'ensemble des description des chque objet, c'est à dire

feuille 1 nommée "objet 1" avec une colonne
colonne A
desc 1
desc 2
desc 3

feuille 2 nommée "objet 2" avec une colonne
colonne A
desc 1
desc 2
desc 3

j'espère avoir été claire pour ma demande ...
Je vous remercie de votre aide .

NB : j'utilise excel 2003

 

[Cousinhub]

Re : création automatique d'onglet dans un classeur

Bonsoir, voisine

regarde le fichier joint

en cliquant sur le bouton jaune, tu obtiens tes onglets, avec le nom de l'objet et les descriptions dans l'onglet

attention aux noms des objets, ils ne doivent pas contenir de caractères interdits ("/", "\", ":", "*", "?", ">", "<", "|") , sinon cela fera planter la macro, lorsqu'elle essaiera de nommer l'onglet....

Bonne soirée

 

[flo29200]

Re : création automatique d'onglet dans un classeur

Merci beaucoup c'est parfait
BZH
...

 

[job75]

Re : création automatique d'onglet dans un classeur

Bonsoir flo, bh2,

Tu ne m'en voudras pas bh2 de présenter ma solution ?

Elle suppose que la colonne A a été triée et qu'il n'y a pas de cellules vides :

Sub CreationFeuilles()
Dim F As Worksheet, ref1 As Range, ref2 As Range
Application.ScreenUpdating = False
[COLOR="Red"]Application.DisplayAlerts = False
On Error Resume Next[/COLOR]
Set F = ActiveSheet
Set ref1 = [A2]
While ref1 <> ""
Set ref2 = ref1.Offset(Application.CountIf(F.[A:A], ref1.Value))
Set plage = F.Range(ref1.Offset(, 1), ref2.Offset(-1, 1))
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = ref1
[COLOR="Red"]If Err Then Sheets(Sheets.Count).Delete: Err = 0[/COLOR]
plage.Copy Sheets(ref1.Value).[A1]
Set ref1 = ref2
Wend
F.Activate
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Edit 1 : les données commencent en A2 dans la feuille de base (la feuille active)

Edit 2 : j'ai modifié la macro (en rouge) pour que l'on puisse sans problème l'exécuter autant de fois que l'on veut.

A+

 

[BOISGONTIER]

Re : création automatique d'onglet dans un classeur

Bonsoir,

Voir PJ

Sub Extrait()
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  [G:G].Insert
  [G1] = [A1]
  shBD = ActiveSheet.Name
  Range("A1:A10000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("G1"), Unique:=True
  For Each c In Range("G2", [G65000].End(xlUp)) ' pour chaque objet
    Sheets(shBD).[G2] = c.Value
    On Error Resume Next
    Sheets(c.Value).Delete
    On Error GoTo 0
    Sheets.Add After:=Sheets(Sheets.Count) ' création
    ActiveSheet.Name = c.Value
    Sheets(shBD).[A1:B10000].AdvancedFilter Action:=xlFilterCopy, _
       CriteriaRange:=Sheets(shBD).[G1:G2], CopyToRange:=[A1]
  Next c
  Sheets(shBD).[G:G].Delete
End Sub

JB