Discussion :

[lejack]

Bonjour à tous,

Je dispose d'un fichier excel de 15 000 lignes divisés par pays dans la colonne H. (il y du contenu de la colonne A à P)
J'aimerais créer un onglet pour chaque pays. Par exemple, si je sélectionne France dans la colonne H grâce à un filtre, j'obtiens 500 lignes. Mon objectif est d'avoir ces 500 lignes dans un nouvel onglet.

Est-ce possible? Je le ferai bien manuellement mais il y a 52 pays et je vais devoir le refaire plusieurs fois...

Merci à tous de votre assisstance.

[halaster08]

Bonjour,

Un code a adapter, il sépare par rapport à la première colonne:

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
Sub OngletsNom()
'cette macro sépare les données ,de la feuille dont le nom est dans la variable data, en une feuille par valeur différentes
'cette macro n'a pas besoin que les données soient triées car elle utilise les filtres avancés.
 
Application.ScreenUpdating = False
Dim FEUILLE_DEST As Worksheet
Dim var As Object
Dim Plage As Range
Dim Cell As Range
Dim i As Long
Data = "RSS_data" 'nom de la feuille des données (a adapter)
 
' création de l'objet SortedList
Set var = CreateObject("System.Collections.SortedList")
 
 
With ThisWorkbook.Worksheets(Data).Cells(1, 1)
    Set Plage = .CurrentRegion  ' plage des données (avec les titres)
    For Each Cell In .CurrentRegion.Columns(1).Cells   ' boucle pour créer la liste sans doublon
        If Not var.containskey(Cell.Value) And Cell.Row > 1 Then
            var.Add Cell.Value, Cell.Text
        End If
    Next Cell
End With
 
 
For i = 0 To var.Count - 1
 
    ' ici on gère le fait que la feuille existe ou non
    On Error Resume Next
        Set FEUILLE_DEST = ThisWorkbook.Worksheets(Plage.Cells(1, 1) & "_" & var.getbyindex(i))
    On Error GoTo 0
 
    ' si la feuille n'existe pas : on la crée et la renomme avec le nom de la var
    If FEUILLE_DEST Is Nothing Then
        Set FEUILLE_DEST = ThisWorkbook.Worksheets.Add
        FEUILLE_DEST.Name = Plage.Cells(1, 1) & "_" & var.getbyindex(i)
        FEUILLE_DEST.Move After:=Sheets(ActiveWorkbook.Sheets.Count)
 
    ' si la feuille existe : on efface tout
    Else
        FEUILLE_DEST.Cells.Clear
    End If
 
    ' utilisation du filtre avancé
    With FEUILLE_DEST
        .Cells(1, 1) = Plage.Cells(1, 1) ' nom du critère (l'entête de la colonne 1)
        .Cells(2, 1) = var.getbyindex(i)            ' valeur du critère : nom de la var (qui est le nom de la feuille)
        Plage.AdvancedFilter xlFilterCopy, .Cells(1, 1).CurrentRegion, .Cells(4, 1), False  ' application du filtre avancé
        .Cells(1, 1).Resize(3, 1).EntireRow.Delete ' nettoyage de la zone des critères (= suppression des lignes 1 à 3)
    End With
 
    Set FEUILLE_DEST = Nothing
Next i
 
 
Application.ScreenUpdating = True
End Sub

[Marc-L]

Bonjour !

Est-ce possible?

Oui déjà juste avec un filtre avancé, le tout en une trentaine de lignes de code …

___________________________________________________________________________________________________________
Je suis Paris, Egypte, Stockholm, London, Istanbul, Berlin, Nice, Bruxelles, Charlie, …

[froutloops62]

Bonjour Halaster8,

Quand j'utilise ton code, mes onglets se créent bien mais je n'ai pas le filtre (j'ai les mêmes données sur toutes les feuilles).

Je dois pour ma part séparer selon la colonne 12.

Voici mon 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
Sub OngletsNom()
'cette macro sépare les données ,de la feuille dont le nom est dans la variable data, en une feuille par valeur différentes
'cette macro n'a pas besoin que les données soient triées car elle utilise les filtres avancés.
 
Application.ScreenUpdating = False
Dim FEUILLE_DEST As Worksheet
Dim var As Object
Dim Plage As Range
Dim Cell As Range
Dim i As Long
Data = "Feuil1"
 
' création de l'objet SortedList
Set var = CreateObject("System.Collections.SortedList")
 
 
With ThisWorkbook.Worksheets(Data).Cells(1, 1)
    Set Plage = .CurrentRegion  ' plage des données (avec les titres)
    For Each Cell In .CurrentRegion.Columns(12).Cells   ' boucle pour créer la liste sans doublon
        If Not var.containskey(Cell.Value) And Cell.Row > 1 Then
            var.Add Cell.Value, Cell.Text
        End If
    Next Cell
End With
 
 
For i = 0 To var.Count - 1
 
    ' ici on gère le fait que la feuille existe ou non
    On Error Resume Next
        Set FEUILLE_DEST = ThisWorkbook.Worksheets(Plage.Cells(1, 12) & "_" & var.getbyindex(i))
    On Error GoTo 0
 
    ' si la feuille n'existe pas : on la crée et la renomme avec le nom de la var
    If FEUILLE_DEST Is Nothing Then
        Set FEUILLE_DEST = ThisWorkbook.Worksheets.Add
        FEUILLE_DEST.Name = Plage.Cells(1, 12) & "_" & var.getbyindex(i)
        FEUILLE_DEST.Move After:=Sheets(ActiveWorkbook.Sheets.Count)
 
    ' si la feuille existe : on efface tout
    Else
        FEUILLE_DEST.Cells.Clear
    End If
 
    ' utilisation du filtre avancé
    With FEUILLE_DEST
        .Cells(1, 1) = Plage.Cells(1, 1) ' nom du critère (l'entête de la colonne 1)
        .Cells(2, 12) = var.getbyindex(i)            ' valeur du critère : nom de la var (qui est le nom de la feuille)
        Plage.AdvancedFilter xlFilterCopy, .Cells(1, 1).CurrentRegion, .Cells(4, 1), False  ' application du filtre avancé
        .Cells(1, 1).Resize(3, 1).EntireRow.Delete ' nettoyage de la zone des critères (= suppression des lignes 1 à 3)
    End With
 
    Set FEUILLE_DEST = Nothing
Next i
 
'auto ajustement de la taille des colonnes pour plus de lisibilité
For Each sh In ThisWorkbook.Sheets
    sh.Cells.EntireColumn.AutoFit
Next sh
 
 
Application.ScreenUpdating = True
End Sub

Merci de ton aide.

[halaster08]

Tu as oublié au moins un changement ici:

Code :

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

1
2
3
4
5
6
    With FEUILLE_DEST
        .Cells(1, 1) = Plage.Cells(1, 12) ' nom du critère (l'entête de la colonne 1)
        .Cells(2, 12) = var.getbyindex(i)            ' valeur du critère : nom de la var (qui est le nom de la feuille)
        Plage.AdvancedFilter xlFilterCopy, .Cells(1, 1).CurrentRegion, .Cells(4, 1), False  ' application du filtre avancé
        .Cells(1, 1).Resize(3, 1).EntireRow.Delete ' nettoyage de la zone des critères (= suppression des lignes 1 à 3)
    End With

[froutloops62]

Désolé, j'ai trop cherché et je suis passé à côté.

Merci beaucoup, ça fonctionne maintenant !