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

  • Initiateur de la discussion Initiateur de la discussion DJISA
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

DJISA

XLDnaute Occasionnel
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

VB:
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
 

Pièces jointes

Bonjour Djisa, Claudy,
J'ai du mal à croire que votre code fonctionnait, tout du moins sous XL2007.
VB:
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à.
 

Pièces jointes

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
VB:
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
 
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.
 

Pièces jointes

RE
bonjour
VB:
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
😉
 
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
 
re
vite fait comme ça on passe plus par value mais par (copy / destination)(sans paste!!)
on arrange les colonne après
VB:
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
😉
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour