Discussion :

[Anouk98]

Bonjour

j'ai un fichier comprenant une centaine de ligne et 17 colonne ( R)

En colonne "F" j'ai des noms de métier. j'aimerais pour chaque nom de métier , créer un onglet qui reprend l'ensemble des données du fichier de base soit x lignse et 17 colonnes. il faudrait également que l'onglet se renomme avec le nom de ce métier.


Ci-dessous le fichier à partir duquel je souhaiterais créer des onglets :
dossier onglet à créer.xlsx


merci d'avance pour votre aide

cdlt
Anouk

[Invité]

Bonjour,
If faut que tu regarde du côté des dictionnary!

Tu scan ta plage de cellules et avec le dictionnary tu répertorie tes métiers .

En suite tu scan ton dictionnaire , tu vérifis l'existence de l'onglet et tu fais un filtre élaboré!

[Theze]

Bonjour,

Teste pour voir si ça te convient. Attention, des métiers ont des noms trop longs donc, tu aura un message te disant quel nom et le nom par défaut que la feuille va porter et qu'il te faudra modifier manuellement après traitement :

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
 
Sub Metier()
 
    Dim Plage As Range
    Dim Cel As Range
    Dim Dico As Object
    Dim Cle As Variant
    Dim I As Integer
    Dim Nom As String
    Dim NomDefaut As String
 
    With Worksheets("feuille1")
 
        Set Plage = .Range(.Cells(2, 6), .Cells(.Rows.Count, 6).End(xlUp))
 
    End With
 
    Set Dico = CreateObject("Scripting.Dictionary")
 
    For Each Cel In Plage
 
        If Dico.exists(Cel.Value) = False Then Dico.Add Cel.Value, Cel.Value
 
    Next Cel
 
    Cle = Dico.keys
 
    For I = 0 To Dico.Count - 1
 
        Worksheets.Add , Sheets(Sheets.Count)
 
        NomDefaut = Worksheets(Sheets.Count).Name
 
        Nom = Split(Dico(Cle(I)), " - ")(1)
 
        On Error Resume Next
        Worksheets(Sheets.Count).Name = Nom
 
        If Err.Number <> 0 Then MsgBox "Une feuille portant le nom '" & Nom & "' existe déjà ou le nom est trop long, la feuille sera nommée par défaut '" & NomDefaut & "' !" & _
                                        vbCrLf & _
                                        "Voulez devrez la renommer manuellement en fin de traitement !"
 
        On Error GoTo 0
 
    Next I
 
End Sub

[Invité]

Bonjour Theze et merci d'avoir mis en application ma proposition!
Je suis sur mon téléphone portable et je ne peux fournir de code!

Ceci dit je pense que le mieux est de tronqué le nom de l'onglet et de l'indexer 1,2,3...

Et d'enchaîner le filtre élaboré, il sera temps ensuite de renommé manuellement les onglets!

[Marc-L]

Bonjour, bonjour !

Vu le peu de données, c'est simple & efficace avec le B-A-BA d'Excel sans dictionnaire …

Anouk, dans les noms des onglets, faut-il conserver le code ou juste l'intitulé ?
Par exemple : S03b - Sécurité ou juste Sécurité ?

______________________________________________________________________________________________________
Je suis Paris, Charlie, Bardo, Sousse, Kenya Garissa University, Liban, Mali, …

[Anouk98]

Bonjour,

merci à tous pour votre réactivité. Je ne réponds que maintenant car avec Nouméa il y a 10h de décalage. Pour les noms on peut juste mettre "sécurité" sans le code avant.

Merci
Anouk

Bonjour Theze,

j'ai testé ta VBA mais il me dit que 'l'indice n'appartient pas à la sélection",.. comme tu le remarques je suis plus que novice dans le vba.

Bien à toi
anouk

[Marc-L]

Dans la démonstration suivante, si un libellé de métier (sans le code donc) est trop grand pour nommer un onglet,
il est automatiquement tronqué et terminé par "…" et chaque référence métier (avec le code)
doit comporter la séquence de caractères " - " sinon cela déclenchera une erreur (facilement contournable) …

Avec juste la fonction de feuille de calculs ESTREF pour vérifier l'existence d'un onglet
et un filtre avancé pour la liste des métiers et alimenter leurs onglets respectifs :

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
Sub Demo()
                Application.ScreenUpdating = False
    With Feuil1
        With .Cells(1).CurrentRegion.Columns
            C& = .Count + 2
            .Item(6).AdvancedFilter xlFilterCopy, , .Parent.Cells(C), True
        End With
        With .Cells(C).CurrentRegion
                VA = .Value
            For R& = 2 To UBound(VA)
                VA(R, 1) = Split(VA(R, 1), " - ")(1)
                If Len(VA(R, 1)) > 31 Then VA(R, 1) = Left(VA(R, 1), 30) & "…"
            Next
            With .Resize(, 2)
                 .Columns(2).Value = VA
                 .Sort .Cells(2), xlAscending, Header:=xlYes
                  VA = .Value
            End With
        End With
        For R = 2 To UBound(VA)
                           .Cells(2, C).Value = VA(R, 1)
            With Worksheets
                If Evaluate("ISREF('" & Replace(VA(R, 2), "'", "''") & "'!A1)") Then _
                  .Item(VA(R, 2)).UsedRange.Clear Else .Add(, .Item(.Count)).Name = VA(R, 2)
            End With
            .Cells(1).CurrentRegion.AdvancedFilter xlFilterCopy, .Cells(C).Resize(2), _
                                                       Worksheets(VA(R, 2)).Cells(1)
        Next
                .Cells(C).CurrentRegion.Clear
    End With
                Application.ScreenUpdating = True
End Sub

______________________________________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …

[Anouk98]

Bonjour Marc,
j'ai copié le code mais j'ai une erreur "400",....je n'arrive pas à faire tourner la VBA.

Bien à toi

Anouk

[Theze]

Bonjour,

il me dit que 'l'indice n'appartient pas à la sélection"

la ligne surlignée en jaune est elle celle là ?

Code :

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

1
2
 
With Worksheets("feuille1")

Dans le classeur posté, la feuille s'appelle "feuille1" mais dans le classeur où tu viens de faire le test elle s'appelle comment ?

[Marc-L]

j'ai copié le code mais j'ai une erreur "400",....je n'arrive pas à faire tourner la VBA.

Démonstration testée de mon côté sans souci avec le classeur joint dans la présentation initiale !
L'as-tu testée avec ce même classeur ?

Le texte du message d'erreur peut mettre sur la voie de la résolution …

Sinon, quel est le numéro de la ligne déclenchant cette erreur ?

Quelle est la version d'Excel (numéro + langue) qui n'a pas été indiquée dans le préfixe de cette discussion ?

[Anouk98]

Bjr theze,

j'ai testé avec le fichier que j'avais posté et effectivement la macro fonctionne. il y a bien des onglets qui se créent par métier mais par contre chaque onglet est vide. je désirais avoir les lignes concernant chaque métier dans chaque onglet ( j'ai du mal m'exprimée)


Bien à toi

Anouk

[Marc-L]

P'tite démonstration :

[Anouk98]

Bonsoir, Marc,

En fait la macro marche tb avec le fichier que j'ai fourni ( création onglet+données) , par contre lorsque je la fait tourner avec le fichier réel, j'ai une erreur " 400". j'ai même collé les données dans le fichier que j'avais mis en modèle mais rien à faire.

bien à toi

ps : mais tu ne dors pas , en métropole c'est la pleine nuit -

je te joins un fichier word avec les copies d'écran de l'endroit ou j'ai un erreur

erreur vba.doc


ma version est xl 2007

[Marc-L]

La feuille source est-elle protégée ?

La colonne métier est bien la sixième ?

[Invité]

Bonjour,

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub test()
Dim Dico As Object, R As Range, cls As Classe1
Set Dico = CreateObject("Scripting.Dictionary")
Set R = ThisWorkbook.Sheets("feuille1").UsedRange
For I = 2 To R.Rows.Count
    If Dico.exists(R(I, 1).Value) = False Then
       Set cls = New Classe1
        Dico.Add R(I, 1).Value, cls
        cls.Mission ThisWorkbook, R(I, 1).Value
    End If
Next
Set Dico = Nothing
End Sub

Code Classe1 :

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
Public Sub Mission(classeur As Workbook, LiBission As String)
Dim Feuille As Worksheet, Filtre As Workbook
    If MissionTrouve(classeur, LiBission) = False Then Set Feuille = classeur.Sheets.Add: Feuille.Name = LiBission Else Set Feuille = classeur.Sheets(LiBission)
    Set Filtre = CreatFiltre(classeur.Sheets("feuille1").Range("A1"), LiBission)
    FiltreActif classeur.Sheets("feuille1").Range("A1").CurrentRegion, Filtre.Sheets(1).UsedRange, Feuille.Range("A1")
    Filtre.Close False
End Sub
Private Function MissionTrouve(classeur As Workbook, LiBission As String) As Boolean
Dim I As Long
For I = 1 To classeur.Sheets.Count
    If UCase(LiBission) = UCase(classeur.Sheets(I).Name) Then MissionTrouve = True: Exit Function
Next
End Function
Private Function CreatFiltre(Tire As String, Filtre As String) As Workbook
Set CreatFiltre = Application.Workbooks.Add
CreatFiltre.Sheets(1).Range("A1") = Tire
CreatFiltre.Sheets(1).Range("A2") = Filtre
End Function
 
Function FiltreActif(RangeSource As Range, CriterRange As Range, CopyRange As Range, Optional Unique As Boolean = True) As Boolean
FiltreActif = False
On Error Resume Next
 RangeSource.AdvancedFilter Action:= _
        xlFilterCopy, CriteriaRange:=CriterRange _
        , CopyToRange:=CopyRange, Unique:=Unique
        DoEvents
        If Err = 0 Then FiltreActif = True
        'MsgBox Err.Description
        On Error GoTo 0
End Function

[Anouk98]

Bonjour rdurupt,

j'ai lancé la macro du fichier et j'ai une erreur 400, si je lance la macro pas à pas ,.; cela bug au niveau

Code :

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

   .Item(6).AdvancedFilter xlFilterCopy, , .Parent.Cells(C), True

avec comme message :

erreur d’exécution 1004 : erreur définie par l'application ou par l'objet

Bien à toi

Bonjour Marc

La feuille source est-elle protégée ?

quid ? désolée mais n'étant pas experte j'aurais besoin d'éxplication

La colonne métier est bien la sixième ?

oui bien en "F",..


cdlt
anouk

[Marc-L]

Si le tableau source comporte 17 colonnes, la colonne située deux colonnes plus loin - donc la 19ème - est bien vide
comme dans le fichier joint initialement ?

[Anouk98]

Bonjour Marc

la 19éme n'était pas vide,...mais même en la vidant et m'arrêtant à la 17éme colonne,... j'ai la même erreur.

cdlt

[Anouk98]

hi Rudrupt,

j'ai finalement pu faire fonctionner la macro ( suppression dernière colonne de mon fichier pour correspondre au nbre de colonne du fichier test), les onglets sont bien créés et les données mais je rencontre deux anomalies :-
-les données recopiées vont jusqu'à la lettre "L" et non "R"
- sur tous les onglets ce sont les mêmes données recopiées, à savoir celle liée au métier O02- grand public

Bien à toi

[Invité]

Bonjour rdurupt,

j'ai lancé la macro du fichier et j'ai une erreur 400, si je lance la macro pas à pas ,.; cela bug au niveau

.Item(6).AdvancedFilter xlFilterCopy, , .Parent.Cells(C), True

avec comme message : erreur d’exécution 1004 : erreur définie par l'application ou par l'objet


Bien à toi

Bonjour,
Difficile de te répondre vue que ça n'a rien à voir avec mon code!