XL 2019 Interrompre une boucle quand la condition n'est plus remplie

[DJISA]

Bonjour le forum!
Avec le code ci-dessous, nous avons créer une boucle pour la création d'un nombre d'onglets prédéfini, ici huit(8), voir la ligne en gras. Mais Nous voudrions aller plus loin en créant une boucle, avec une variable onglet , qui s'interromperait au dernier élément de la liste dont l'étendue dépend de l'utilisateur.
Nous joignons une fichier

Sub mes_classes()
[B]For Each cell In Range("A5:A12")[/B]
Set feuille = Worksheets.Add(After:=Worksheets(Worksheets.Count))

feuille.Name = cell.Value
feuille.Range("C4").Value = "Classe"
feuille.Range("D4").Value = "Nro"
feuille.Range("E4").Value = "Prénom"
feuille.Range("F4").Value = "Nom"
feuille.Range("G4").Value = "Date de naissance"
feuille.Range("H4").Value = "Lieu de naissance"
feuille.Range("I4").Value = "Sexe"
feuille.Range("J4").Value = "Age"
feuille.Range("K4").Value = "Tutelle"
feuille.Range("L4").Value = "Adresse tutelle"
feuille.Range("M4").Value = "Tél tutelle"
feuille.Range("N4").Value = "Tél élève"
feuille.Range("O4").Value = "Orphelin"
feuille.Range("P4").Value = "Handicap"
feuille.Range("Q4").Value = "Dossier"
feuille.Range("R4").Value = "Nro ext"

feuille.Range("C5").Value = cell.Offset(0, 1).Value
feuille.Range("D5").Value = cell.Offset(0, 1).Value
feuille.Range("E5").Value = cell.Offset(0, 1).Value
feuille.Range("F5").Value = cell.Offset(0, 1).Value
feuille.Range("G5").Value = cell.Offset(0, 1).Value
feuille.Range("H5").Value = cell.Offset(0, 1).Value
feuille.Range("I5").Value = cell.Offset(0, 1).Value
feuille.Range("J5").Value = cell.Offset(0, 1).Value
feuille.Range("K5").Value = cell.Offset(0, 1).Value
feuille.Range("L5").Value = cell.Offset(0, 1).Value
feuille.Range("M5").Value = cell.Offset(0, 1).Value
feuille.Range("N5").Value = cell.Offset(0, 1).Value
feuille.Range("O5").Value = cell.Offset(0, 1).Value
feuille.Range("P5").Value = cell.Offset(0, 1).Value
feuille.Range("Q5").Value = cell.Offset(0, 1).Value
feuille.Range("R5").Value = cell.Offset(0, 1).Value
Next cell

End Sub

Merci d'avance
DJISA

 

[Claudy]

Bonjour...
Touche ESC en haut à gauche de ton clavier..??
Bon dimanche,
Claudy

 

[sylvanu]

Bonjour Djisa, Claudy,
J'ai du mal à croire que votre code fonctionnait, tout du moins sous XL2007.

Votre code :
feuille.Range("C4").Value = "Classe"
Code qui marche :
Sheets(feuille).Range("C4").Value = "Classe"

Votre code :
Set feuille = Worksheets.Add(After:=Worksheets(Worksheets.Count))
Code qui marche :
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = Nom
feuille = cell.Value

En PJ, les feuilles crées sont celles dans la liste Créer des classes. Il s'arrete à la fin de la lite.
A noter qu'il n'y a aucune sécurité dans votre code. Si on appuie une seconde fois, cela génère une erreur car les feuilles existent déjà.

 

[patricktoulon]

bonjour
@sylvanu allons!!! c'est un tableau structuré

tu a un tableau structuré tu n'a donc plus a te soucier de connaitre la fin ,le databodyrange de tableau1 te donne la plage sans l’entête

Sub mes_classes()
    Dim index&, cell As Range, Feuille As Worksheet
    For Each cell In Feuil1.ListObjects("Tableau1").DataBodyRange
        index = index + 1
        If TypeName(Evaluate(cell.Text & "!A:B")) <> "Range" Then
            With Worksheets.Add(after:=Worksheets(index))
                .Name = cell.Value
                .Range("C4:r4").Value = Feuil1.[C4:R4].Value
                .Range("C5:r5").Value = Feuil1.[C5:R5].Value
            End With
        End If
    Next cell
End Sub

et la sécurité en ce qui concerne l’existence d'un onglet est gérer
tu peux lancer et relancer autant de fois que tu veux ça n'ajoutera que les onglets manquants et en prime si je me suis pas trompé dans le même ordre

 

[DJISA]

Salut Patricktoulon, le forum!
J'ai testé ton code et cela marche. Merci beaucoup!
Mais est-il possible d'intégrer dans la boucle une mise en forme qui s'appliquera à toutes les feuilles qui seront crées. Je voudrais que les pages se créent avec des tableaux identiques à celui figurant dans la feuil1.
Je te renvoie le fichier avec une petite modification à la feuil1.
Merci.

 

[patricktoulon]

RE
bonjour

Sub mes_classes()
    Dim index&, cell As Range, Feuille As Worksheet
    For Each cell In Feuil1.ListObjects("Tableau1").DataBodyRange
        index = index + 1
        If TypeName(Evaluate(cell.Text & "!A:B")) <> "Range" Then
            With Worksheets.Add(after:=Worksheets(index))
                .Name = cell.Value
                .Range("C4:R5").Value = Feuil1.[C4:R5].Value
                .ListObjects.Add(xlSrcRange, Range("C4:R5"), , xlYes).Name = "Tableau_" & cell.Value
                .ListObjects("Tableau_" & cell.Value).TableStyle = "TableStyleMedium2"
            End With
        End If
    Next cell
End Sub

 

[DJISA]

Salut Patricktoulon, le Forum!
J'ai testé le code mais cela marche en partie. J'ai constaté que, dans les nouveaux onglets créés, les tableaux ne respectent pas les mêmes largeurs de colonne et la police d'écriture définies dans le tableau figurant dans l'onglet "maquette".
Merci
DJISA

 

[patricktoulon]

re
bonsoir heuuu... c'est moi ou il y a eu une soudaine disparition de moquette chez toi ?
je n'est pas vu d'onglet maquette dans ton fichier

 

[patricktoulon]

re
vite fait comme ça on passe plus par value mais par (copy / destination)(sans paste!!)
on arrange les colonne après

Sub mes_classes()
    Dim index&, cell As Range, Feuille As Worksheet,col as range
    For Each cell In Feuil1.ListObjects("Tableau1").DataBodyRange
        index = index + 1
        If TypeName(Evaluate(cell.Text & "!A:B")) <> "Range" Then
            With Worksheets.Add(after:=Worksheets(index))
                .Name = cell.Value
                Feuil1.[C4:R5].Copy Destination:=.Range("C4")
                .ListObjects(1).Name = "tableau_" & .Name
                For Each col In .Range("C4:R5").Columns
                    col.ColumnWidth = Feuil1.Columns(col.Column).ColumnWidth
                Next
            End With
        End If
    Next cell
End Sub

oui je sais cette ligne est amusante
col.ColumnWidth = Feuil1.Columns(col.Column).ColumnWidth

 

[DJISA]

Bonjour Patricktoulou, le forum!
Merci encore pour le pas que vous me faites franchir et surtout pour la promptitude dans les réponses.
Merci
DJISA

 

[patricktoulon]

re
de rien
je précise
que copy destination:=.... a pour effet non seulement de copier le formatage mais l'object tableau structuré aussi

 

[DJISA]

Ok. C'est intéressant
DJISA