Discussion :

[jdeveuster]

Bonjour à tous,

Je tiens avant tout à remercier la communauté qui m'a permis de m'aider de nombreuses fois :-) Malheureusement, cette fois-ci je vais devoir prendre ma plume car je ne trouve pas la solution.

Mon objectif est d'arriver à classer des données sur différentes feuilles. Je m'explique:
J'ai un tableau avec 9 colonnes (nom, prénom, lieu de naissance, ville, etc.). L'idée est de regrouper toutes ces infos par CODE POSTAL (colonne 9).
Donc l'idée est d'avoir plusieurs feuilles: 109 ,501, 318, etc. Et sur chaque page, je retrouverais la/les lignes copiées à partir du doc initial.

J'ai trouvé un code sur ce forum qui me permet de faire l'exercice si je me base sur les villes (lettres), malheureusement ce code ne fonctionne pas avec les chiffres...

Pourriez-vous me dire comment adapter ce code afin que cela fonctionne également avec des chiffres?

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
Sub LancerImpressionFacturesNouvelleMacro()
Dim MotCle
Dim i As Byte
Dim C As Range
Dim F As String
Dim Ligne As Long
Sheets.Add
ActiveSheet.Name = "sheet1"
Sheets.Add
ActiveSheet.Name = "sheet2"
Sheets.Add
ActiveSheet.Name = "sheet3"
Sheets.Add
ActiveSheet.Name = "sheet4"
Sheets.Add
ActiveSheet.Name = "sheet5"
Sheets.Add
ActiveSheet.Name = "sheet6"
Sheets.Add
ActiveSheet.Name = "sheet7"
Sheets.Add
ActiveSheet.Name = "sheet8"
Sheets.Add
ActiveSheet.Name = "sheet9"
Sheets.Add
ActiveSheet.Name = "sheet10"
    Sheets("Données_fin").Select
    Sheets("Données_fin").Copy Before:=Sheets(3)
    Sheets("Données_fin (2)").Select
    Sheets("Données_fin (2)").Name = "Résumé"
    Application.Run "CodeMut"
    'On définit les mots clés
    MotCle = Array("101", "108", "109", "126", "128", "129", "130", "132", "134", "135", "137", "203", "203", "206", "216", "226", "228", "232", "305", "306", "315", "317", "319", "323", "325", "403", "409", "501", "506", "509", "516", "526", "527", "602", "605", "609", "622", "871", "910", "940", "951")
    'On effectue la recherche de chaque mot clé dans la colonne F de la sheet1
    For i = 0 To UBound(MotCle)
        Do
            Set C = Worksheets("Données_fin").Columns(10).Find(MotCle(i), LookIn:=xlValues, lookat:=xlPart)
            'Si le mot clé est trouvé
            If Not C Is Nothing Then
                'On définit le nom de la feuille où sera effectuée la copie
                F = "sheet" & (i + 2)
                With Worksheets(F)
                    'On définit la ligne où sera effectué le collage
                    Ligne = .Range("F" & Rows.Count).End(xlUp).Row + 1
                    'On effectue le copier / coller
                    C.EntireRow.Copy .Range("A" & Ligne)
                    'On supprime la ligne dans la sheet1
                    C.EntireRow.Delete
                End With
            End If
        Loop While Not C Is Nothing
    Next i
    Sheets("Données_fin").Select
    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
    Sheets("Menu").Select
    Sheets("Menu").Move Before:=Sheets(1)
    Sheets("Résumé").Select
    Sheets("Résumé").Move Before:=Sheets(2)
End Sub

Pour info, je cale à la ligne : With Worksheets(F)
Pour info 2: j'ai rajouté les (ActiveSheet.Name = "sheet6") sinon le code ne marche pas avec les villes.

Je reste à votre dispositions pour plus d'informations.

Merci encore.

[MarcelG]

Bonsoir,

Si j'ai bien compris, tu veux créer autant de feuilles qu'il y a de codes postaux dans ta feuille initiale.
Chacune reprenant les éléments de celle-ci.

Alors, regarde cette - modeste - contribution
création de feuilles depuis occurences sur synthèse

[jdeveuster]

Merci Marcel pour ce tutoriel bien intéressant! J'avoue que la première partie est plus compliquée et que j'ai du mal à m'y retrouver (je suis vraiment débutant). Mais grâce à l'exemple que tu fournis plus loin, le code semble plus clair.

J'ai pu adapter quelque peu le code pour qu'il fonctionne dans mon document. Voici ce que ça donne:

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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
 
Option Explicit
Option Compare Text
 
Dim liste As Range
Dim numcol As Integer
 
Sub Crée_Feuiles()
    Dim dercel As Range
    Dim choix_col As Variant
 
With Sheets("Données_fin")
            Set dercel = .Cells(.Rows.Count, 9).End(xlUp)
            Set liste = .Range(.Cells(2, 9), dercel)
    End With
 
    Call Creer_Liste_Feuilles(liste)
    Set dercel = Nothing
    Set liste = Nothing
 
End Sub
 
Sub Creer_Liste_Feuilles(Plage As Range)
    Dim Cell As Range
    Dim Un As Collection
    Dim i As Long, j As Long
    Dim Inverse1, Inverse2, Item
 
    Set Un = New Collection
 
    On Error Resume Next
 
    'Boucle sur la plage de cellule
    For Each Cell In Plage
        'If Cell <> "" Permet de ne pas prendre en compte les cellules vides
        'Un.Add Cell, CStr(Cell) Ajoute le contenu de la cellule dans la collection
        If Cell <> "" Then Un.Add Cell, CStr(Cell)
    Next Cell
 
    On Error GoTo 0
 
    'Trie la collection
    'D'après F. Sigonneau
 
    For i = 1 To Un.Count - 1
        For j = i + 1 To Un.Count
            If Un(i) > Un(j) Then
                Inverse1 = Un(i)
                Inverse2 = Un(j)
                Un.Add Inverse1, Before:=j
                Un.Add Inverse2, Before:=i
                Un.Remove i + 1
                Un.Remove j + 1
            End If
        Next j
    Next i
 
    'Retour à Silkyroad
    'Boucle sur les éléments de la collection.
    For i = 1 To Un.Count
        Debug.Print Un(i)
        Call Gestion_Feuilles(Un(i))
    Next i
 
    Set Un = Nothing
 
End Sub
 
Public Sub Gestion_Feuilles(occurs As String)
 
Dim i As Integer, n As Integer, nbcol As Integer
 
Dim f As Range, celcop As Range
 
Dim firstAddress As String
 
Dim Tablo() As Variant
 
Dim sh As Worksheet
 
Dim existe_feuil As Boolean
 
With Sheets("Données_fin")
    Set celcop = .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft))
End With
'nombre de données à alimenter = dimension 1 de la variable Tablo
nbcol = celcop.Columns.Count
 
'Teste si la feuille existe
existe_feuil = False
For Each sh In Worksheets
    If sh.Name = occurs Then
        existe_feuil = True
        Exit For
    End If
Next sh
 
'Si la feuille n'existe pas, alors création de celle-ci avec nom et titres de colonnes adaptés
If existe_feuil = False Then
    Sheets.Add Type:=xlWorksheet, After:=Sheets(Sheets.Count)
    celcop.Copy
    With ActiveSheet
        .Paste Destination:=.Range("A1")
        .Name = occurs
    End With
    Application.CutCopyMode = False
End If
 
'D'après l'aide en ligne de la méthode Find
With liste
    Set f = .Find(occurs, LookIn:=xlValues)
    If Not f Is Nothing Then
        firstAddress = f.Address
        Do
                n = n + 1
                ReDim Preserve Tablo(1 To nbcol, 1 To n)
                'Toutes les cellules de la ligne alimentent Tablo
                For i = 1 To nbcol
                        Tablo(i, n) = f.Offset(0, i - numcol)
                Next i
                Set f = .FindNext(f)
        Loop While Not f Is Nothing And f.Address <> firstAddress
    End If
End With
 
 
'Alimentation de la feuille
With Sheets(occurs)
         .Range("A2", .Range("A2").Offset(UBound(Tablo, 2) - 1, UBound(Tablo, 1) - 1)).Value = WorksheetFunction.Transpose(Tablo)
End With
 
'Réinitialisation de la variable Tablo
Erase Tablo
 
End Sub

Cela fonctionne correctement, je retrouve bien ma colonne 9 étalée sur différentes pages mais malheureusement, je rencontre deux petits problèmes:
1) Je ne retrouve dans les feuilles que les données allant de la colonne 10 et + et elles sont encodées dans le colonnes A,B,C, etc.
2) Les pages sont renommées avec le nom de la mut. Je pense que ça va conduire à quelques petits problèmes lorsque je ferai un publipostage de ces données. En effet, l'idée générale de ce classeur est de créer des factures par numéros. Ce qui implique qu'il faudrait peut-être mieux avoir des feuilles avec un nom "classique" nommées "Feuil1", "Feuil2", etc. Afin que mon publipostage fonctionne automatiquement chaque mois. (Il se peut qu'un mois on ai 109, 509 et 318 mais le mois d'après 509, 101 et 224).

Merci encore pour votre aide et pour le temps que vous consacrez à ma demande :-)

[MarcelG]

Bonjour,

Il faut adapter le code à ton besoin.
Pourrais-tu le joindre en version simplifiée de quelques lignes (avec peu d'occurrences, donc peu de codes postaux)

[jdeveuster]

Y'a plein d'autres macros dans le classeur mais voici le document en question.
J'ai laissé le code placé dans mon dernier post dans le fichier.

[MarcelG]

Salut,

Et pour cause!
La variable numcol n'est pas initiée telle qu'elle peut l'être dans ma contribution.
(relis-la depuis le début)

Pour simplification, je l'ai informée en terme réel.

Code :

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

1
2
3
4
5
Sub Crée_Feuiles()
 
numcol = 9 'colonne que tu veux occurencer
 
......