Macro generer feuille sans doublons

[jpp1961]

Salut à tous ou plutôt bonsoir

Dans un classeur excel j'ai 2 feuilles
1ère feuille qui se nomme: "Base"
2ème feuille qui se nomme: "Modèle"

Dans la feuille "Base" en colonne A j'ai une liste d'environ 150 noms
Feuille "Modèle" c'est ma feuille qui me sert de base

Je souhaiterai générer autant de feuille qu'il y a de noms dans la feuille base.
Et que chaque feuille porte le nom de la liste.
Si le nom de feuille existe déjà dans le classeur qu'il passe au suivant sans ecraser les données eventuelles qu'elle aurait
ex:
Classeur à l'ouverture:
j'ai dans l'ordre les feuilles: Base - Modèle - test 2

Dans la feuille Base en colonne A les noms suivant:
test 1
test 2
test 3
etc...

La macro devrait me générer les feuilles (copie de modèle)suivantes à la suite de la feuille Modèle:
test 1
(test 2) elle existe déjà donc pas de copie
test 3
etc.

voir fichier joint

Help merci à tous

 

[JNP]

Re : Macro generer feuille sans doublons

Bonsoir JPP1961 ,
Tu pourrais trouver plein de cas dans le forum en faisant une petite recherche ...

Sub CréationFeuilles()
Dim Cell As Range
On Error Resume Next
For Each Cell In Sheets("Base").Range("A1:A" & Range("A65536").End(xlUp).Row)
Sheets("Modèle").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Cell.Value
Next Cell
On Error GoTo 0
End Sub

devrait faire l'affaire.
Bonne nuit

 

[CBernardT]

Re : Macro generer feuille sans doublons

Bonsoir JPP1961, JNP,

Une réalisation précédente un peu identique et adaptée avec des messages d'alerte.

Un bonus, la macro qui permet de supprimer les feuilles faites avec les noms de la base.

Bonne nuit à vous

 

[ROGER2327]

Re : Macro generer feuille sans doublons

Bonsoir à tous

Ou encore :

[COLOR="DarkSlateGray"][B]Private Sub CommandButton1_Click()
   toto Me.Name
   Me.Activate
End Sub

Sub toto(sh$)
Dim i&
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   Application.EnableEvents = False
   With Sheets(sh)
      For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
         If Not IsEmpty(.Cells(i, 1)) Then
            Sheets("Modèle").Copy After:=Sheets(Sheets.Count)
            On Error GoTo E:
            ActiveSheet.Name = .Cells(i, 1).Value
            On Error GoTo 0
         End If
      Next i
   End With
   Application.EnableEvents = True
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True
Exit Sub
E: Application.DisplayAlerts = False
   ActiveSheet.Delete
   Application.DisplayAlerts = True
Resume Next
End Sub[/B][/COLOR]

ROGER2327
#3443

18 Floréal An CCXVIII
2010-W18-5T23:02:14Z

 

[jpp1961]

Re : Macro generer feuille sans doublons

Bonsoir JPP1961 ,
Tu pourrais trouver plein de cas dans le forum en faisant une petite recherche ...

Sub CréationFeuilles()
Dim Cell As Range
On Error Resume Next
For Each Cell In Sheets("Base").Range("A1:A" & Range("A65536").End(xlUp).Row)
Sheets("Modèle").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Cell.Value
Next Cell
On Error GoTo 0
End Sub

devrait faire l'affaire.
Bonne nuit

Un grand merci à tous les couche-tard JNP, Roger et Cbernard

je vais tester vos macro

merci beaucoup

 

[ROGER2327]

Re : Macro generer feuille sans doublons

Suite...

Le code que je propose plus haut n'est pas très efficace s'il existe déjà beaucoup de feuilles créées. Plus rapide sera :

[COLOR="DarkSlateGray"][B]Private Sub CommandButton1_Click()
   toto Me.Name
   Me.Activate
End Sub

Sub toto(sh$)
Dim i&, j&
   With Application
      .ScreenUpdating = False
      .Calculation = xlCalculationManual
      .EnableEvents = False
      With Sheets(sh)
         For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
            If Not IsEmpty(.Cells(i, 1)) Then
               For j = 1 To Sheets.Count
                  If Sheets(j).Name = .Cells(i, 1).Value Then Exit For
               Next j
               If j > Sheets.Count Then
                  Sheets("Modèle").Copy After:=Sheets(Sheets.Count)
                  ActiveSheet.Name = .Cells(i, 1).Value
               End If
            End If
         Next i
      End With
      .EnableEvents = True
      .Calculation = xlCalculationAutomatic
      .ScreenUpdating = True
   End With
End Sub[/B][/COLOR]

Un code de suppression peut être utile, comme le fait remarquer CBernardT. En voici un autre :

[COLOR="DarkSlateGray"][B]Sub supprime()
   otot Me.Name
End Sub

Sub otot(sh$)
Dim i&
   With Application
      .ScreenUpdating = False
      .Calculation = xlCalculationManual
      .EnableEvents = False
      .DisplayAlerts = False
      On Error Resume Next
      With Sheets(sh)
         For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
            If Not IsEmpty(.Cells(i, 1)) Then Sheets(.Cells(i, 1).Value).Delete
         Next i
      End With
      On Error GoTo 0
      .DisplayAlerts = True
      .EnableEvents = True
      .Calculation = xlCalculationAutomatic
      .ScreenUpdating = True
   End With
End Sub[/B][/COLOR]

ROGER2327
#3446

19 Floréal An CCXVIII
2010-W18-6T08:31:43Z

 

[MOUMED]

Re : Macro generer feuille sans doublons

Merci atous je vous demande de m'aider a trouver le code d'une botton qui donne l'appartion d'une feuil excel par son nom par exemple dans un classeur .