Créer des onglets à partir d'une liste

Charlotte0309 -  
ThauTheme Messages postés 1442 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

Je souhaite créer à partir d'une liste situé dans un onglet "sommaire" de nouveaux onglets reprenant le texte de la liste.

Par exemple ma liste dans l'onglet sommaire

France
Espagne
Pays 3
Pays 4
...

Je souhaite créer à partir de cette liste un onglet par pays.

Merci pour votre aide !

Bien à vous,

Charlotte

1 réponse

ThauTheme Messages postés 1442 Date d'inscription   Statut Membre Dernière intervention   160
 
Bonsoir Charlotte, bonsoir le forum,

Le code ci-dessous, à adapter, fait ce que tu demandes avec la gestion d'éventuels doublons dans ta liste. Mais je n'ai pas poussé la gestion des caractères interdits dans un nom d'onglet en présumant que ta liste en serait exempte...

Le code
Sub Macro2()
Dim S As Object 'déclare la variable S (onglet Sommaire)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
Dim I As Integer 'déclare la variable I (Incrément)
Dim NO As Object 'déclare la variable NO (Nouvel Onglet)

Set S = Sheets("sommaire") 'définit l'onglet s
DL = S.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée Dl de la colonne 1 (=A) de l'onglet S (à adapter)
TC = S.Range("A1:A" & DL) 'définit le tableau de cellules TC (à adapter, doit correspondre à la liste...)
For I = 1 To UBound(TC, 1) 'boucle sur toutes les lignes du tableau TC
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la liogne suivante)
    Set NO = Sheets(TC(I, 1)) 'définit l'onglet NO (génère une erreur si cet onglet n'existe pas)
    If Err <> 0 Then 'condition : si une erreur a été générée
        Err.Clear 'supprime l'erreur
        Sheets.Add after:=Sheets(Sheets.Count) 'ajoute un nouvel onglet en dernière position
        ActiveSheet.Name = TC(I, 1) 'renomme l'onglet
    End If ' fin de la condition
    On Error GoTo 0 'annule la gestion des erreurs
Next I 'prochaine ligne de la boucle
End Sub

0