[RESOLU] Excel - Recopie d'onglets de manière paramétrée

[choupe]

Bonjour

J'ai un excel avec des onglets que je voudrais dupliquer suivant un onglet contenant :
Colonne 1 : Nom du futur onglet
Colonne 2 : Nom de la template à dupliquer

copierOnglet.png (15.6 Kio) Consulté 90 fois

comment faire ?

Merci

[choupe]

Voici une macro Excel

Code : Tout sélectionner

Sub DupliquerOnglet()
'
' DupliquerOnglet Macro
' Un onglet liste contient une liste avec 1er colonne = nom onglet a creer et 2eme colonne = nom de la feuille a copier
'

'

 Dim x As Integer
      Sheets("Liste").Select
      ' Set numrows = number of rows of data.
      NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count
      ' Select cell a1.
      Range("A1").Select
      ' Establish "For" loop to loop "numrows" number of times.
      For x = 1 To NumRows
         nameOfSheet = Sheets("Liste").Range("A" & x).Value
         nameOfTemplate = Sheets("Liste").Range("B" & x).Value
         ' Insert your code here.
         Sheets(nameOfTemplate).Select
         Sheets(nameOfTemplate).Copy After:=Sheets(3)
         ActiveSheet.Select
         ActiveSheet.Name = nameOfSheet
         ' Selects cell down 1 row from active cell.
         ActiveCell.Offset(1, 0).Select
      Next

    
End Sub

[choupe]

Voici une modification pour :
- Garder l'ordre de la liste
- Ajouter un lien hypertexte vers l'onglet généré depuis l'onglet liste

Code : Tout sélectionner

Sub DupliquerOnglet()
'
' DupliquerOnglet Macro
' Un onglet liste contient une liste avec 1er colonne = nom onglet a creer et 2eme colonne = nom de la feuille a copier
'

'

 Dim x As Integer
      Sheets("Liste").Select
      ' Set numrows = number of rows of data.
      NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count
      ' Select cell a1.
      Range("A1").Select
      ' Establish "For" loop to loop "numrows" number of times.
      For x = 1 To NumRows
         nameOfSheet = Sheets("Liste").Range("A" & x).Value
         nameOfTemplate = Sheets("Liste").Range("B" & x).Value
         ' Insert your code here.
         Sheets(nameOfTemplate).Select
         Sheets(nameOfTemplate).Copy Before:=Sheets(1 + x)
         ActiveSheet.Select
         ActiveSheet.Name = nameOfSheet
         ' Ajoute un lien vers l'onglet
         Sheets("Liste").Select
         ActiveSheet.Range("C" & x).Select
         ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", _
                    SubAddress:="'" & nameOfSheet & "'!A1", TextToDisplay:="Lien vers l'onglet"
         ' Selects cell down 1 row from active cell.
         ActiveCell.Offset(1, 0).Select
      Next

    
End Sub