XL 2019 Créer autant de feuilles qu'il y a de valeur unique dans une colonne

Lionel69890

XLDnaute Junior
Bonjour à tous,

Ne connaissant rien au VBA .... sic .... Quelqu'un peut-il m'aider à créer une macro qui me permettrait de créer autant de feuille qu'il y a de valeur unique dans mes ressources (colonne D)

Si possible que ces feuilles soient ajoutées après ma feuille contenant mes données et classées par ordre alphabétique.

Merci d'avance pour votre aide
 

Pièces jointes

  • Créer une feuille pour chaque valeur unique de ressources.xlsx
    94.6 KB · Affichages: 7

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour Lionel, bonjour le forum,

Essaie ce code :

VB:
Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim O As Worksheet 'déclare la variable O (Onglet)

Set OS = Worksheets("FEUILLE TEST") 'définit l'onglet source OS
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    D(TV(I, 4)) = "" 'alimente le dictionnaire D avec les données en colonne 4 de TV (Ressources)
Next I 'prochaine ligne de la boucle
TMP = D.Keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublon (les clés)
Call Tri(TMP, LBound(TMP), UBound(TMP)) 'lance la procédure de tri alphabétiques du tableau TMP
For I = 0 To UBound(TMP) 'boucle sur tous les éléments I du tableau temporaire TMP
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
    Set O = Worksheets(TMP(I)) 'définit l'onglet O (génère une erreur si cet onglet n'existe pas)
    If Err > 0 Then 'condition : si une erreur a été généré
        Err.Clear 'supprime l'erreur
        Worksheets.Add After:=Sheets(Sheets.Count) 'ajoute l'onglet de la boucle en dernière position
        ActiveSheet.Name = TMP(I) 'renomme l'onglet
        Set O = ActiveSheet 'définit l'onglet O
    End If 'fin de la condition
    On Error GoTo 0 'annule la gestion des erreurs
Next I 'prochain élément de la boucle
End Sub

Sub Tri(a, gauc, droi) ' Quick sort ---> tiré du site de Jacques Boisgontier : http://boisgontierj.free.fr/
ref = a((gauc + droi) \ 2)
g = gauc: D = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(D): D = D - 1: Loop
    If g <= D Then
        TMP = a(g): a(g) = a(D): a(D) = TMP
        g = g + 1: D = D - 1
    End If
Loop While g <= D
If g < droi Then Call Tri(a, g, droi)
If gauc < D Then Call Tri(a, gauc, D)
End Sub
 

Lionel69890

XLDnaute Junior
Merci Robert cela correspond plus à ma demande mais VGENDRON a anticipé mon souhait car sa macro copie les lignes correspondant à chacune de mes ressources dans sa feuille respective :)
Le top pour moi aurait été la macro de VGENDRON avec pour chaque feuille créées l'insertion de la premier ligne (entête) entre chaque changement de date. Mais je veux pas abusé c'est déjà super sympa de m'aider
Lionel
 

Discussions similaires