XL 2013 Ordre des onglets créés par rapport à une liste de départ

[Yudlo]

Bonjour à tous,
Je débute en VBA et parfois il me manque quelques subtilités

Mon fichier est constitué d'une macro qui va me chercher un fichier source et copie des données (dites périmètre)
D'un onglet modèle qui doit être généré à chaque création d'un nouvel onglet.

A partir du périmètre, j'ai une macro qui crée des onglets : elle fonctionne très bien, c'est parfait sauf que les onglets se créent dans l'ordre inverse du tableau : dernière ligne du tableau = 1er onglet
Et j'ai besoin, pour pouvoir intégrer des éléments de synthèse à cette liste de départs:
- que le 1er onglet corresponde à la 2eme ligne de tableau (1er nom et non intitulé du tableau), que le 2e onglet corresponde à la ligne 3 du tableau donc au 2eme nom et ainsi de suite.
- qu'il ne crée pas d'onglet pour la dernière ligne du tableau qui est un "total" et qui n'est pas toujours sur la même ligne selon les fichiers sources (qui ne dépassent cependant pas 20 lignes)
Qu'est ce qu'il manque à mon code?!
je pense que c'est là : For ln = 20 To fb.Range("B" & Rows.Count).End(xlUp).Row (je triche en laissant une ligne vide pour que la ligne total ne soit pas prise en compte ) mais je ne comprends pas comment faire autrement, tout ce que je tente plante ou est trop complexe pour mon niveau

Option Explicit

Dim fm As Worksheet, f As Worksheet, MSA As String, dico As Object
Dim fb As Worksheet
Dim i&, ln&, lgn&, col&

Sub Onglet()

    Application.ScreenUpdating = False
    Set fb = ActiveSheet ' fiche perimetre
    Set fm = Sheets("Modele") 'fiche modele
    Set dico = CreateObject("Scripting.Dictionary") ' liste du périmetre
    
    
    For Each f In Worksheets
        dico(f.Name) = ""
    
    Next f
    
    Sheets("Modele").Visible = True
    
    For ln = 20 To fb.Range("B" & Rows.Count).End(xlUp).Row 'à partir de la ligne 20 prendre les données de la colonne B jusqu'à la cellule vide
        MSA = fb.Range("B" & ln) 'une feuille par ligne du périmètre
        If Not dico.exists(MSA & " ") Then
            Sheets("Modele").Copy after:=Sheets("Périmètre") 'copie le modele du guide pour chaque onglet créée après périmètre
            ActiveSheet.Name = MSA & " " ' la donnée MSA (colonn B) est le nom de l'onglet
            Range("C10") = MSA 'Range la donnée en C10 de chaque onglet
            Range("H10") = fb.Range("F" & ln) 'Range la donnée de la colonne F en N10 de chaque onglet
            Range("K10") = fb.Range("G" & ln) 'Range la donnée de la colonne G en O10 de chaque onglet
            
            
        End If
    
    Next ln
    
    Sheets("Modele").Visible = True 'passer en false quand tout est ok pour masquer la feuille modèle
    

End Sub

Et si je peux abuser , histoire d'apprendre et de comprendre, est ce que vous pouvez commenter vos réponses code ?!

Merci d'avance!

 

[Hasco]

Bonjour,

Je vous propose dans la modification ci-dessous, de partir de la dernière ligne du tableau en remontant jusqu'à la ligne 20.

La dernière ligne étant égale à 20 + nombre de lignes du tableau -5 (entêtes) -1

CurrentRegion correspond à la plage que vous obtenez en faisant CTRL+* quand la cellule active est dans votre tableau

    ' Parcourir le tableau de la dernière ligne à la première

    For ln = 20 + fb.Range("B20").CurrentRegion.Rows.Count - 6 To 20 Step -1 'à partir de la ligne 20 prendre les données de la colonne B jusqu'à la cellule vide
        MSA = fb.Range("B" & ln)
        If Not dico.exists(MSA & " ") Then
            Sheets("Modele").Copy after:=Sheets("Périmètre") 'copie le modele du guide pour chaque onglet créée
            ActiveSheet.Name = MSA & " " ' la donnée MSA (colonn B) est le nom de l'onglet
            Range("C10") = MSA 'Range la donnée en C10 de chaque onglet
            Range("H10") = fb.Range("F" & ln) 'Range la donnée de la colonne F en N10 de chaque onglet
            Range("K10") = fb.Range("G" & ln) 'Range la donnée de la colonne G en O10 de chaque onglet
       
       
        End If

Ainsi vos feuilles sont créées dans l'ordre de leur apparition juste après la feuille "Périmètre".

Détail : personnellement j'aurai utilisé un tableau en mémoire pour les noms de feuilles au lieu d'un objet dictionary qui n'est pas natif à vba.

L'objet dictionary étant utile lorsqu'on veut une liste d'items uniques, ce que la collection Worksheets comporte déjà.

Sub Onglet2()
    
    Dim feuilles() As String 
    
    ReDim feuilles(1 To Worksheets.Count)
    i = 0
    For Each f In Worksheets
        i = i + 1
        feuilles(i) = f.Name
    Next f
     '
     ' ......
     '
      For ln = ........
        MSA = fb.Range("B" & ln)
       '
       ' Tester si le nom MSA est dans le tableau des feuilles préexistantes
        If LBound(Filter(feuilles, MSA)) = 0 Then
          '
          '  Faire ce qu'il y a à faire si le nom de la feuille n'existe pas dans le tableau           
            
        End If
      Next 
End Sub

de plus il serait peut-être bon de rajouter, avant le Next, le nom de la nouvelle feuille créée au tableau (ou au dico) au cas où ce nom existerait malencontreusement 2 fois dans votre colonne B (erreur de saisie, duplication involontaire d'une ligne etc..)

Il est toujours préférable d'isoler les tableaux de données du contenu adjacent par une ligne vide au dessus (si première ligne du tableau >1) et en dessous ainsi qu'une colonne vide à droite et à gauche (si colonne1 du tableau > A).

Ayant excel 2016 vous pourriez tirer avantage des tableaux structurés

Cordialement

 

[soan]

Bonjour Yudlo, Roblochon,

ton fichier en retour.

* ouvre le fichier joint ; au départ, tu es sur la feuille "Périmètre".

* fais Alt F8 ➯ fenêtre "Macro" ; sélectionne la macro "Onglet" ; clique sur le bouton Exécuter ➯ 9 feuilles ont été créées, de "c" à "lav", et la feuille active est maint'nant la 1ère feuille créée, donc "c".

note que j'ai amélioré la présentation de H1 et de H3 ; sur la feuille "Périmètre", sais-tu que tu as des 0 cachés derrière tes cellules grises de la plage G20:i28 ? ça explique que par exemple sur la feuille "b", tu as un 0 (visible) en H10 et un 0 caché en K10 ; c'est juste pour info, et j'ai laissé tel que ; après, libre à toi de t'amuser avec ton Excel comme tu l'entends. c'est p't'être un jeu bonus ? l'utilisateur doit deviner où sont les zéros cachés ? quel est le lot à gagner pour celui qui trouve ? et j'y ai droit, moi aussi ? ou c'est un jeu réservé pour les employés d'la maison ? ​

Option Explicit

Sub Onglet()
  Const s As String * 9 = "Périmètre": If ActiveSheet.Name <> s Then Exit Sub
  Dim fb As Worksheet, dico, MSA$, lig&, n%, i%: n = Worksheets.Count
  Set fb = Worksheets(s): Set dico = CreateObject("Scripting.Dictionary")
  For i = 1 To n: dico(Worksheets(i).Name) = "": Next i 'noms feuilles
  With Worksheets("Modèle")
    Application.ScreenUpdating = 0: .Visible = -1
    For lig = 20 To fb.Cells(Rows.Count, 2).End(3).Row 'col B, lig 20 à dernière lig utilisée,
      MSA = fb.Cells(lig, "B")                         'une feuille par ligne du périmètre
      If Not dico.exists(MSA) Then
        .Copy , Worksheets(n) 'copie le modèle du guide en dernière feuille, pour chaque onglet créé
        ActiveSheet.Name = MSA 'la donnée MSA (en colonne B) est le nom du nouvel onglet créé
        [C10] = MSA                'MSA : col B en C10 (xx contrôlée)
        [H10] = fb.Cells(lig, "G") 'Type de mutualisation : col G en H10
        [K10] = fb.Cells(lig, "H") 'Mutualisation pour la : col H en K10
      End If
      n = n + 1 'le classeur contient une feuille de plus, donc nombre total de feuilles : +1
    Next lig
    .Visible = 0 'passer à 0 quand tout est ok pour masquer la feuille modèle
  End With
  If n > 3 Then Worksheets(4).Select
End Sub

à te lire pour avoir ton avis.

soan

 

[Yudlo]

Oua merci à tout les deux , je regarde ce qui me correspond le mieux et je reviens vers vous!

Pour répondre à Roblochon , je comprends votre commentaire sur l'object dictionnary. En réalité j'ai "piqueuh" un bout de code et je l'ai arrangé à ma sauce mais il vrai que lorsque j'ai voulu comprendre cet objet, j'ai été très mal à l'aise ! Or il fonctionne en l'état, du coup je n'ai pas cherché plus loin. En ce sens, votre proposition est intéressante
Par contre il est impossible d'avoir 2 lignes du périmètre avec le même nom : en l'espèce c'est une question que je ne me pose pas!
Pour Soan, oui il y'a des crucs cachés parce que le périmètre vient d'un fichier auquel je n'ai pas le droit de toucher (penser/étudier/regarder!!) sous peine de mort douloureuse et qui est traité sous access et macro et que sais-je ! du coup ça doit venir de là j'imagine...

En tout cas merci à tous les deux, je regarde tout ca avec attention et je reviens vite vous dire !

 

[Yudlo]

Merci Merci, tout fonctionne hyper bien, entre les deux mon cœur balance : la solution de Roblochon est plus proche de mon code mais celle de Soan m'amène à réfléchir

Juste une petite question à chacun: je comprends intellectuellement mais j'ai du mal à traduire "mot à mot" : Or pour ma reprise du vélo, me faut reprendre les petites roues !!
For lig = 20 To fb.Cells(Rows.Count, 2).End(3).Row : à quoi correspond (3) ?
For ln = 20 + fb.Range("B20").CurrentRegion.Rows.Count - 6 To 20 Step -1 : 20 = lignes du tableau ok; -1 ok entête et -5 ?
ça doit être tout bête en plus et d'une logique implacable !
En tout cas, cette nuit je ne rêverais plus de de Row ! merci vraiment à tous les deux.

Edit : j'aurais aimé mettre la coche aux deux codes !!

 

[soan]

@Yudlo

fb.Cells(Rows.Count, 2).End(3).Row : idem que fb.Cells(Rows.Count, 2).End(xlUp).Row

soan

 

[Hasco]

20 = lignes du tableau ok; -1 ok entête et -5 ?

Sélectionnez une cellule de votre tableau et Faites CTRL+* Vous verrez que la sélection du tableau prend les 5 lignes au-dessus puisqu'elles ne sont pas séparées du tableau par une ligne vide, il faut donc les retrancher du compte.

Cordialement

 

[Yudlo]

@Yudlo

fb.Cells(Rows.Count, 2).End(3).Row : idem que fb.Cells(Rows.Count, 2).End(xlUp).Row

soan

merci !

 

[Yudlo]

Sélectionnez une cellule de votre tableau et Faites CTRL+* Vous verrez que la sélection du tableau prend les 5 lignes au-dessus puisqu'elles ne sont pas séparées du tableau par une ligne vide, il faut donc les retrancher du compte.

Cordialement

Merci beaucoup!