Discussion :

[benoit2000]

Bonjour,
Je souhaiterai faire une macro qui, à partir de ma colonne d’axes, créé automatiquement des feuilles excel associées respectivement à ces axes.
J’ai en effet un tableau excel qui contient un ensemble de liste d’opération (1 ligne = 1 opération) avec une colonne qui définit les axes auxquels appartiennent ces opérations (colonne D). Je souhaiterai que pour chaque axe, la macro crée automatiquement différentes feuilles excel associées à ces opérations.

Je vous joint mon xls,

Merci d'avance de votre aide,

Benoit

[jerome.vaussenat]

Salut,

Normalement, je ne fait de code clé en main. Je préfère donner un coup de main pour que les personne puissent progresser. C'est la philosophie de ce forum.

Mais, comme j'ai codé toute la journée, je suis chaud et donc voila.

J'espère avoir compris ta demande qui consiste à créer une feuille pour chaque axe. Et j'ai mis sur chaque feuille l'extraction correspondante.

Pour info, tout le code est commenté. C'est une déformation.
J'ai rencontré deux problèmes :
Les noms de feuilles ne peuvent pas contenir de "/". Donc si un axe contient un /, il est remplacé par un -.
Les noms de feuilles ne peuvent pas avoir plus de 31 caractères. Et certaine de tes axes en font plus. Du coup, j'ai été obligé de tronqué. Je ne garde que les 31 premiers caractères.
Mais du coup, certaine de noms de feuilles comme "Le Mans-Angers-Nantes-St Nazaire" étaient en double. Et excel il n'aime pas que 2 feuilles aient le même nom. Donc, pour éviter les doublons de nom à moins de 31 caractères, j'ai généré un nombre aléatoire qui se place en fin.

Voici le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
Sub Macro1()
'
' Macro1 Macro
'
'déclaration des variables
    Dim lignes As Integer
    Dim cpt As Integer
    Dim axe As String
 
    'affichage d'un message dans la barre d'état pour faire patienter
    Application.StatusBar = "Je bosse, SVP !!!"
    'désactivation de la mise à jour de l'écran pour éxécution plus rapide
    Application.ScreenUpdating = False
    'activation de la gestion manuelle des erreurs
    On Error Resume Next
 
    'copie de la colonne D en colonne G pour extraire les douclon et n'avoir chaque axe qu'une fois
    Columns("D:D").Select
    Selection.Copy
    Range("G1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("$G:$G").RemoveDuplicates Columns:=1, Header:=xlYes
 
    'on détermine combien il y a d'axes
    lignes = Range("G65635").End(xlUp).Row
    'mise en place d'une boucle pour chaque axe
    For cpt = 4 To lignes
        'on mémorise le texte de l'axe
        axe = Cells(cpt, 7).Value
        'filtre du tableau pour ne garder que les lignes concernées
        ActiveSheet.Range("$A$5:$D$5").AutoFilter Field:=4, Criteria1:=axe
 
        'copie et mise en forme des lignes concernées dans une nouvelle feuille
        Range("A5").CurrentRegion.Select
        Selection.Copy
        Sheets.Add After:=ActiveSheet
        ActiveSheet.Paste
        Range("A:D").WrapText = False
        Application.CutCopyMode = False
        Columns("A:D").EntireColumn.AutoFit
 
        'Les noms de feuille ne peuvent pas contenir de /. Remplacement par des -
        'un nom de feuille ne peut pas faire plus de 31 caractères, on ne garde que les premiers
        axe = Left(Replace(axe, "/", "-"), 31)
        ActiveSheet.Name = axe
        Do While Err.Number <> 0
            'comme on ne garde que les 31 1er caractères, il peut y avoir des noms identique
            'mise en place N° aléatoire pour éviter les doublons de noms
            Err.Number = 0
            axe = Left(axe, 30) & Int(Rnd * 10)
            'modification du nom de la feuille
            ActiveSheet.Name = axe
        Loop
        'retour sur la première feuille
        Sheets(1).Activate
    Next
    'suppression de la colonne G (avec extraction sans doublons
    Feuil1.Columns("g").Delete
    'Placement dans la cellule A5
    Range("A5").Select
    'affichage de toutes les données
    ActiveSheet.ShowAllData
    'On enlèvle le message d'attente de la barre d'état
     Application.StatusBar = False
     'affichage d'un message de fin
     MsgBox "La ventilation c'est correctement effectuée" & Chr(13) _
        & ThisWorkbook.Sheets.Count - 1 & " feuilles ont été créées"
End Sub

et tu as le fichier en pièce jointe.

Bonne utilisation. Attention, je n'assure pas le service après vente !

[benoit2000]

Que dire

Un grand merci a toi jerome.vaussenat pour cette macro qui fonctionne à merveille.

bonne journée