Copie et remplissage automatique de feuilles sur base d'une liste valeurs

Bonjour et très bonnes fêtes de fin d'année à tous !

Je cherche à créer une simple macro qui va aller créer une copie de la feuille B (dans le même classeur) et coller la valeur suivante de la liste ci-dessous sur chaque nouvelle copie. Chaque feuille copiée devra être renommée par le nom de la valeur copiée.

Bonjour,

Voici un essai :

Sub test()

dim onglets()

onglets = array("Rouge", "Vert", "Jaune", "Bleu")

for i = lbound(onglets) to ubound(onglets)
    Sheets("B").copy(after:=Sheets(Sheets.count)).name = onglets(i)
    Sheets(onglets(i)).range("A1").value = onglets(i) 'SI BUG, remplacer sheets(onglets(i)) par sheets(sheets.count)
next i

end sub

Bonnes fêtes à vous aussi.

Cdlt,

Alors il me met "erreur 424" "objet requis" :?

Merci BEAUCOUP pour votre aide !

NB : si je veux remplacer les valeurs dans Array par des plages de cellules je peux juste mettre A1:A3 par exemple svp ?

Hugo

Bonjour,

Oui c'est possible. Voici un code plus complet qui teste notamment l'existence des feuilles avant leur duplication :

Sub DuplicationFeuille()

Dim wsname$

onglets = Application.Transpose(Sheets("B").Range("A1:A4")) <<<ADAPTER : range avec les noms d'onglets

For i = LBound(onglets) To UBound(onglets) 'pour chaque nom d'onglet à créer
    Sheets("B").Copy after:=Sheets(Sheets.Count) 'copie feuille B en derniere position
    With Sheets(Sheets.Count) 'avec nouvelle feuille
        wsname = onglets(i) 'stocke nom feuille
        If Not feuilleexiste(wsname) Then 'si la feuille n'existe pas
            .Name = onglets(i) 'nouveau nom d'onglet
            .Range("A1").Value = onglets(i) 'A1 vaut nom de l'onglet
        Else 'sinon, si feuille existe
            Application.DisplayAlerts = False 'désactive alertes
            .Delete 'supprime feuille nouvellement créée
            Application.DisplayAlerts = True 'réactive alertes
            MsgBox "La feuille """ & onglets(i) & """ existe déjà, elle n'a pas pu être créée !", vbCritical, "Echec copie"
        End If
    End With
Next i

End Sub

Function feuilleexiste(nomfeuille$) As Boolean
On Error Resume Next
feuilleexiste = Sheets(nomfeuille).Index
End Function

Cdlt,

Ça marche ! juste merci beaucoup !!!!

Passez de très bonnes fêtes.

Hugo

Nickel !

Merci, très bonnes fêtes de fin d'année à vous aussi !

Cdlt,