création feuille dans fichier excel

[gvives]

Bonjour à tous,

Je souhaite pouvoir créer de façon automatique des onglets excel en VBA en fonction d'une feuille sommaire.

Je vous joint un fichier test où j'ai expliqué le fonctionnement,

Pourriez vous m'aider SVP ?

Merci beaucoup à tous...

 

[job75]

Re : création feuille dans fichier excel

Bonjour gvives,

Dans le code de la 1ère feuille (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_Change(ByVal Target As Range)
'Feuil2 est le CodeName de la feuille modèle
Dim r As Range
Set r = Intersect(Target, [C:C], Me.UsedRange)
If r Is Nothing Then Exit Sub
Application.ScreenUpdating = False
On Error Resume Next 'si la feuille à créer n'existe pas
For Each r In r
  If UCase(r.Text) = "R" And r(1, 0).Text <> "" Then
    If IsError(Sheets(Left(r(1, 0).Text, 31))) Then
      Feuil2.Copy After:=Sheets(Sheets.Count)
      With Sheets(Sheets.Count)
        .Name = Left(r(1, 0).Text, 31)
        .[G1] = .Name
        .Visible = True
      End With
    Else
      Sheets(Left(r(1, 0).Text, 31).Visible = True
    End If
  End If
Next
Me.Activate
End Sub

Fichier joint.

A+

 

[gvives]

Re : création feuille dans fichier excel

Merci beaucoup Job75 !!

Un seul point... je ne sais pas si c'est facile à modifier...

Lorsque j'enlève les "R" les feuilles ne se remasquent pas automatiquement...

Peut tu maider ?

Merci beaucoup 🙂

 

[job75]

Re : création feuille dans fichier excel

Re,

J'ai complété la macro pour masquer/démasquer les feuilles :

Private Sub Worksheet_Change(ByVal Target As Range)
'Feuil2 est le CodeName de la feuille modèle
Dim r As Range, w As Worksheet
Set r = Intersect(Target, [C:C], Me.UsedRange)
If r Is Nothing Then Exit Sub
Application.ScreenUpdating = False
On Error Resume Next 'si la feuille à créer n'existe pas
For Each r In r
  If UCase(r.Text) = "R" And r(1, 0).Text <> "" Then
    If IsError(Sheets(Left(r(1, 0).Text, 31))) Then
      Feuil2.Copy After:=Sheets(Sheets.Count)
      With Sheets(Sheets.Count)
        .Name = Left(r(1, 0).Text, 31)
        .[G1] = .Name
      End With
    End If
  End If
Next
'---masquage des feuilles---
For Each w In Worksheets
  If w.Name <> Me.Name Then w.Visible = False
Next
'---démasquage des feuilles notées "R"---
For Each r In [C:C].SpecialCells(xlCellTypeConstants)
  If UCase(r) = "R" Then _
    Sheets(Left(r(1, 0).Text, 31)).Visible = True
Next
Me.Activate
End Sub

Fichier (2).

A+

 

[gvives]

Re : création feuille dans fichier excel

Ha c'est parfaittttt !!

Merci beaucoup beaucoup pour ce travail !!

Bonne soirée 😉

 

[job75]

Re : création feuille dans fichier excel

Re,

Je ne sais pas ce qui se passe avec le fichier (2).

Si j'entre R en C1 et que je tire vers le bas, les feuilles ne se créent pas correctement : leur nom n'est pas bon et donc elles se masquent.

Je n'ai pas ce problème avec le fichier (3) ci-joint, pourtant je n'ai rien fait de spécial 😕

Vous avez ce phénomène chez vous ???

A+

 

[job75]

Re : création feuille dans fichier excel

Re,

La différence c'est que sur le fichier (2) la feuille modèle BC... est affichée alors qu'elle est masquée sur le fichier (3) qui marche bien.

C'est forcément un problème au niveau de Sheets(Sheets.Count) mais pourquoi, je ne vois pas 😕

A+

 

[job75]

Re : création feuille dans fichier excel

Re,

Bon, il faut afficher la feuille modèle avant de la copier :

Private Sub Worksheet_Change(ByVal Target As Range)
'Feuil2 est le CodeName de la feuille modèle
Dim r As Range, w As Worksheet
Set r = Intersect(Target, [C:C], Me.UsedRange)
If r Is Nothing Then Exit Sub
Application.ScreenUpdating = False
On Error Resume Next 'si la feuille à créer n'existe pas
For Each r In r
  If UCase(r.Text) = "R" And r(1, 0).Text <> "" Then
    If IsError(Sheets(Left(r(1, 0).Text, 31))) Then
      Feuil2.Visible = True 'affiche la feuille modèle
      Feuil2.Copy After:=Sheets(Sheets.Count)
      With Sheets(Sheets.Count)
        .Name = Left(r(1, 0).Text, 31)
        .[G1] = .Name
      End With
    End If
  End If
Next
'---masquage des feuilles---
For Each w In Worksheets
  If w.Name <> Me.Name Then w.Visible = False
Next
'---démasquage des feuilles notées "R"---
For Each r In [C:C].SpecialCells(xlCellTypeConstants)
  If UCase(r) = "R" Then _
    Sheets(Left(r(1, 0).Text, 31)).Visible = True
Next
Me.Activate
End Sub

Utilisez ce fichier (4).

A+

 

[gvives]

Re : création feuille dans fichier excel

Rebonjour Job 75

Ca marche parfaitement chez moi avec le fichier 4... Je n'avais pas identifié le problème avec la précédente version mais merci vraiment beaucoup !!!

Gaëtan

 

[gvives]

Re : création feuille dans fichier excel

Rebonjour Job75,

Je n'avais pas prévu une chose quand j'ai préparé mon fichier test...

En fait mon classeur excel comportera plusieurs feuilles sommaire BCLEAD avec des BC1, BC2, BC3... , DLEAD avec D1, D2, D3 ... , SLEAD...

Est-il possible de gérer indépendamment les feuilles commençant par BC avec le sommaire BCLEAD et celles commençant par D avec le sommaire DLEAD ?

Merci de ton aide...

Gaëtan

 

[job75]

Re : création feuille dans fichier excel

Bonjour gvives,

Deux feuilles modèles ou plus ne posent aucun problème :

Private Sub Worksheet_Change(ByVal Target As Range)
'Feuil2 et Feuil3 sont les CodeName des feuilles modèles
Dim r As Range, w As Worksheet
Set r = Intersect(Target, [C:C], Me.UsedRange)
If r Is Nothing Then Exit Sub
Application.ScreenUpdating = False
On Error Resume Next 'si la feuille à créer n'existe pas
For Each r In r
  If UCase(r.Text) = "R" Then
    If IsError(Sheets(Left(r(1, 0).Text, 31))) Then
      Set w = Nothing
      If Left(r(1, 0), 2) = "BC" Then Set w = Feuil2
      If Left(r(1, 0), 1) = "D" Then Set w = Feuil3
      If Not w Is Nothing Then
        w.Visible = True 'affiche la feuille modèle
        w.Copy After:=Sheets(Sheets.Count)
        With Sheets(Sheets.Count)
          .Name = Left(r(1, 0).Text, 31)
          .[G1] = .Name
        End With
      End If
    End If
  End If
Next
'---masquage des feuilles---
For Each w In Worksheets
  If w.Name <> Me.Name Then w.Visible = False
Next
'---démasquage des feuilles notées "R"---
For Each r In [C:C].SpecialCells(xlCellTypeConstants)
  If UCase(r) = "R" Then _
    Sheets(Left(r(1, 0).Text, 31)).Visible = True
Next
Me.Activate
End Sub

Notez que les 2 tests sur "BC" et "D" respectent la casse. On peut les adapter.

Fichier (5).

A+

 

[gvives]

Re : création feuille dans fichier excel

Merci Job 75 !

C super !!!!

Je n'ai plus qu'à adapter maintenant ...

Très bon week end 🙂