Création onglet VBA Excel Tri alphabétique

Le 27/12/2017 à 09:25

Bonjour à tous,

Je me permets de poster un message sur le forum car j'ai besoin d'aide.

J'ai créé un code vba dans le but d'automatiser la création ou duplication d'onglets (à partir d'une feuille maquette_D)

Dans une feuille INDEX je viens renseigner un tableau qui me permets de définir le nombre et le nom des onglets

J'aimerai que lorsque je crée mes onglets via une base (feuille index), que les onglets se crées à la suite de la feuille "Maquette_D" mais par ordre alphabétique.

je débute en VBA mais j'ai beau tourner le code je ne trouve pas la solution ...

voici mon code:

Sub Creation_CS()

Dim Comptes_section As Range 'Définition de la plage de cellules

Dim Ws As Worksheet

Dim x As Integer

'Ensuite, je lui affecte l'ensemble des cellules de la zone A2:A1048576 (Rows.Count)

'qui contiennent des données (SpecialCells(xlCellTypeConstants))

Set Comptes_section = Sheets("INDEX").Range("B3:B" & Rows.Count).SpecialCells(xlCellTypeConstants)

'La boucle suivante balaie toutes les cellules de la plage définie

For Each Cel In Comptes_section

Sheets("Maquette_D").Select

Cells.Copy

Sheets.Add after:=Sheets("Maquette_D")

ActiveSheet.Paste

'Enfin, je récupère la ligne de la cellule en cours de lecture :

ActiveSheet.Cells(1, 2) = Sheets("INDEX").Cells(Cel.Row, 2)

ActiveSheet.Name = Cells(1, 2) 'nom des feuilles

' Application des mises en forme à toutes les feuilles attention il faut que les feuilles soient toutes visibles

Application.ScreenUpdating = False

For i = 1 To Sheets.Count

Sheets(i).Visible = xlSheetVisible

Sheets(i).Activate

ActiveWindow.Zoom = 70 'zoom 70% sur toutes les feuilles

Next i

Application.ScreenUpdating = True

Next

End Sub

Merci de votre aide

Le 27/12/2017 à 10:41

Bonjour,

Pour trier les onglets alphabétiquement ... tu peux tester le code suivant ...

En te placant sur ton premier onglet de maquettes ... tu peux lancer cette macro ...

Sub TrierOnglets()

Dim N As Integer
Dim M As Integer
Dim PremWSATrier As Integer
Dim DerWSATrier As Integer
Dim TriDescendant As Boolean

TriDescendant = False

If ActiveWindow.SelectedSheets.Count = 1 Then
    PremWSATrier = 2
    DerWSATrier = Worksheets.Count
Else
    With ActiveWindow.SelectedSheets
        For N = 2 To .Count
            If .Item(N - 1).Index <> .Item(N).Index - 1 Then
                MsgBox "Pas possible de trier des onglets non-adjacents"
                Exit Sub
            End If
        Next N
        PremWSATrier = .Item(1).Index
        DerWSATrier = .Item(.Count).Index
     End With
End If

For M = PremWSATrier To DerWSATrier
    For N = M To DerWSATrier
        If TriDescendant = True Then
            If UCase(Worksheets(N).Name) > UCase(Worksheets(M).Name) Then
                Worksheets(N).Move Before:=Worksheets(M)
            End If
        Else
            If UCase(Worksheets(N).Name) < UCase(Worksheets(M).Name) Then
               Worksheets(N).Move Before:=Worksheets(M)
            End If
        End If
     Next N
Next M
End Sub

En espérant que cela t'aide ...

Le 27/12/2017 à 10:48

Merci de ta réponse.

J'ai déjà une macro du même type.

Le problème c'est que j'aimerai que le tri s'effectue que sur les onglets créé à la suite du lancement de ma macro ...

je vais étudier ton code pour voir si je peux l'adapter

Merci beaucoup de ton aide

Le 27/12/2017 à 11:01
laseck a écrit :

Merci de ta réponse.

J'ai déjà une macro du même type.

Le problème c'est que j'aimerai que le tri s'effectue que sur les onglets créé à la suite du lancement de ma macro ...

je vais étudier ton code pour voir si je peux l'adapter

Merci beaucoup de ton aide

Re,

C'est exactement le cas ...la macro n'intervient que sur les onglets concernés ... en excluant l'onglet Maquette ...

Le 27/12/2017 à 11:48

Re.

j'ai tester la macro à la liant à mon code.

Je souhaiterai que les feuilles qui son compris entre la feuille D et la feuille E se classent automatiquement...

mais si je modifie les lignes suivantes:

If ActiveWindow.SelectedSheets.Count = 1 Then

PremWSATrier = 2

DerWSATrier = Worksheets.Count

en :

PremWSATrier = sheets("d")

DerWSATrier = sheets ("e")

cela ne marche pas ... dsl je me sens nul...

Le 27/12/2017 à 12:02

c'est bon je crois que cela marche:

j'ai modifier le code par :

If ActiveWindow.SelectedSheets.Count = 1 Then

PremWSATrier = Sheets("Maquette_D").Index

DerWSATrier = Sheets("Maquette_E").Index

Else

cela à l'air de marcher

Merci beaucoup de ton aide

Le 27/12/2017 à 12:03

Re,

Avant de coupler la macro de tri à d'autres macros ...

Est-ce-que, comme convenu initialement, ton onglet Maquette est bien le premier onglet ... et lances-tu la macro de tri depuis cet onglet de base ...???

Le 27/12/2017 à 12:11

Pour que ce soit plus clair:

j'ai trois onglets avant mon onglet maquette_D.

Cet onglet me permet à partir d'une table de créer 30 autres onglets d_0001 ... xxxx

Ces onglets se génèrent après mon onglet maquette car ce n'est n'y plus n'y moins qu'une duplication de la feuille. Mais? j'ai dix autres feuilles derrières.

Le souci c'est que lorsque je génère ma macro, les onglets se génèrent en ordre décroissant ...

En adaptant ta macro et en bornant entre deux feuilles j'arrive à classer juste les onglets créées.

Je vais réfléchir à une autre solution, mais cela m'a déjà bien aidé

Le 27/12/2017 à 12:13

Re,

Content que tu aies pu trouver un début de solution à ton problème ...

Merci ... pour tes remerciements ...

Le 27/12/2017 à 16:54

je ne voudrais pas abuser mais est il possible de générer le nom des onglets créé par la macro, sans passer par formule/gestionnaire de nom/nouveau

et

est il possible de générer automatiquement les liens hypertextes, des onglets créé par la macro uniquement, dans une feuille déjà existante (feuille synthèse) à partir de la cellule B8 ?

Sub Creation_CS()

Application.Calculation = xlCalculationManual

Application.EnableEvents = False

Application.ScreenUpdating = False

Dim Comptes_section As Range 'Définition de la plage de cellules

Dim Ws As Worksheet

Dim x As Integer

Dim N As Integer

Dim M As Integer

Dim PremWSATrier As Integer

Dim DerWSATrier As Integer

Dim TriDescendant As Boolean

Dim I As Long, nf As Variant

'Ensuite, je lui affecte l'ensemble des cellules de la zone A2:A1048576 (Rows.Count)

'qui contiennent des données (SpecialCells(xlCellTypeConstants))

Set Comptes_section = Sheets("INDEX").Range("B3:B" & Rows.Count).SpecialCells(xlCellTypeConstants)

'La boucle suivante balaie toutes les cellules de la plage définie

For Each Cel In Comptes_section

Sheets("Maquette_D").Select

Cells.Copy

Sheets.Add after:=Sheets("Maquette_D")

ActiveSheet.Paste

'Enfin, je récupère la ligne de la cellule en cours de lecture :

ActiveSheet.Cells(1, 2) = Sheets("INDEX").Cells(Cel.Row, 2)

ActiveSheet.Name = Cells(1, 2) 'nom des feuilles

' Application des mises en forme à toutes les feuilles attention il faut que les feuilles soient toutes visibles

For I = 1 To Sheets.Count

Sheets(I).Visible = xlSheetVisible

Sheets(I).Activate

ActiveWindow.Zoom = 70 'zoom 70% sur toutes les feuilles

Next I

Next

'Tri des onglets

TriDescendant = False

If ActiveWindow.SelectedSheets.Count = 1 Then

PremWSATrier = Sheets("Maquette_D").Index

DerWSATrier = Sheets("E").Index

Else

With ActiveWindow.SelectedSheets

For N = 2 To .Count

If .Item(N - 1).Index <> .Item(N).Index - 1 Then

MsgBox "Pas possible de trier des onglets non-adjacents"

Exit Sub

End If

Next N

PremWSATrier = .Item(1).Index

DerWSATrier = .Item(.Count).Index

End With

End If

For M = PremWSATrier To DerWSATrier

For N = M To DerWSATrier

If TriDescendant = True Then

If UCase(Worksheets(N).Name) > UCase(Worksheets(M).Name) Then

Worksheets(N).Move before:=Worksheets(M)

End If

Else

If UCase(Worksheets(N).Name) < UCase(Worksheets(M).Name) Then

Worksheets(N).Move before:=Worksheets(M)

End If

End If

Next N

Next M

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Application.Calculation = xlCalculationAutomatic

Application.EnableEvents = True

Application.ScreenUpdating = True

MsgBox "Traitement terminé"

End Sub

Rechercher des sujets similaires à "creation onglet vba tri alphabetique"