Scinder un fichier en plusieurs onglets selon un critère d'une colonne

O

OTW

XLDnaute Nouveau
Bonjour à tous,

Lecteur à mes heures de cet excellent forum où j'ai pu glaner quelques précieuses informations, je n'ai pas trouvé ici réponse à ma question et me lance donc dans une question.

Cf. fichier joint, j'ai un onglet avec différentes données.

La colonne "D" a une donnée qui est "Oui" ou "Non"

Je souhaiterai pouvoir scinder les "Oui" et les "non" dans deux onglets différents, et bien évidemment de manière automatique, afin de pouvoir modifier mon onglet "données" à loisir.

L'idée serait également d'avoir une méthode pour faire de même sur d'autres colonnes le cas échéant, avec plus de deux choix (Ex colonne "I", P1, P2, P3, etc....) et donc plus d'onglets créés au besoin.

D'avance merci pour vos conseils avisés.

Nota : totalement novice en VBA le cas échéant :) mais j'apprendrai !

Steph.
 

Pièces jointes

  • SuiviDossiers-test.xlsx
    21.9 KB · Affichages: 65
Trier par date Trier par votes
Staple1600

Staple1600

XLDnaute Barbatruc
Re : Scinder un fichier en plusieurs onglets selon un critère d'une colonne

Bonsoir à tous


Une version modifiée (si on a des prénoms à la place des P1, P2)
(test OK sur mon PC)

EDITION: Pour faciliter le test, sur le fichier exemple que tu as joins, lance d'abord la macro prenoms avant SpliDataII.
Code: 
Sub prenoms()
'macro à utiliser juste pour tester SplitDataII
'permets de remplir la colonne I de prénoms
Dim i&, tp
tp = Array("Marc", "Alain", "Jacques", "Henri", "Armand", "Hélène", "Solange", "Eric", "France", "Isabelle")
For i = 2 To 189 Step 9
Cells(i, "I").Resize(UBound(tp)) = Application.Transpose(tp)
Next i
Range("I190:I194").FillDown
End Sub


NB: On conserve bien évidemment la macro DeleteWorksheets telle quelle.
Code: 
Sub SplitDataII()
'EDITION version modifiée pour copier la ligne d'entête
'code initial d'Alex P. ->-> stackoverflow
Dim DataMarkers(), Names As Range, name As Range, n As Long, i As Long

'ajout ligne pour tri
ActiveSheet.Columns("A:I").Sort key1:=Range("I2"), order1:=xlAscending, Header:=xlYes

    Set Names = Range(Cells(2, "I"), Cells(Rows.Count, "I").End(xlUp))
    n = 0
    DeleteWorksheets
    For Each name In Names
        If name.Offset(1, 0) <> name Then
            ReDim Preserve DataMarkers(n)
            DataMarkers(n) = name.Row
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).name = name
            n = n + 1
        End If
    Next name
  For i = 0 To UBound(DataMarkers)
        If i = 0 Then
        Worksheets(1).Range("A1:I1").Copy Destination:=Worksheets(i + 2).Range("A1")
        Worksheets(1).Range("A2:I" & DataMarkers(i)).Copy Destination:=Worksheets(i + 2).Range("A2")
        Else
        Worksheets(1).Range("A1:I1").Copy Destination:=Worksheets(i + 2).Range("A1")
        Worksheets(1).Range("A" & (DataMarkers(i - 1) + 1) & ":R" & DataMarkers(i)).Copy Destination:=Worksheets(i + 2).Range("A2")
        End If
    Next i
End Sub
 
Vote positif 0 Vote négatif
O

OTW

XLDnaute Nouveau
Re : Scinder un fichier en plusieurs onglets selon un critère d'une colonne

Bonjour Staple1600.

Merci beaucoup.

Avec un peu de retard, j'ai enfin pu tester, ça fonctionne très bien sauf que lorsque je lance la , lorsque j'ai un prénom, dans le fichier ci-joint qui n'est présent qu'une seule fois, Henri par exemple, il démultiplie ce dernier et créé dans l'onglet créé "x" lignes au lieu de n'en avoir qu'une.


Question ultime pour reprendre un point ci-dessus, comment faire pour avoir la même chose, mais avec en plus la distinction "Oui" et "Non" : création des onglest "henri Oui", "Henri Non" ; Pierre "Oui", "Pierre Non", etc...

D'avance merci.
 

Pièces jointes

  • SuiviDossiers-test 11-03.xlsm
    34 KB · Affichages: 43
Vote positif 0 Vote négatif
gosselien

gosselien

XLDnaute Barbatruc
Re : Scinder un fichier en plusieurs onglets selon un critère d'une colonne

Bonjour,

en triant les 2 colonnes, et en concaténant les 2 zones, on peut faire une comparaison, j'ai juste modifié un rien le code de "Staple"

Sub SplitDataII()
'EDITION version modifiée pour copier la ligne d'entête
'code initial d'Alex P. ->-> stackoverflow
Dim DataMarkers(), Names As Range, name As Range, n As Long, i As Long

'ajout ligne pour tri
' ici modif tri
ActiveSheet.Columns("A:I").Sort Key1:=Range("I2"), Order1:=xlAscending, Header:=xlYes, _
Key2:=[D2], Order2:=xlAscending, Header:=xlGuess

Set Names = Range(Cells(2, "I"), Cells(Rows.Count, "I").End(xlUp))
n = 0
DeleteWorksheets
For Each name In Names
concat = name & name.Offset(0, -5) ' ici modif
concat2 = name.Offset(1, 0) & name.Offset(1, -5) ' ici modif
If concat <> concat2 Then
ReDim Preserve DataMarkers(n)
DataMarkers(n) = name.Row
Worksheets.Add(After:=Worksheets(Worksheets.Count)).name = concat
n = n + 1
End If
Next name
For i = 0 To UBound(DataMarkers)
If i = 0 Then
Worksheets(1).Range("A1:I1").Copy Destination:=Worksheets(i + 2).Range("A1")
Worksheets(1).Range("A2:I" & DataMarkers(i)).Copy Destination:=Worksheets(i + 2).Range("A2")
Else
Worksheets(1).Range("A1:I1").Copy Destination:=Worksheets(i + 2).Range("A1")
Worksheets(1).Range("A" & (DataMarkers(i - 1) + 1) & ":R" & DataMarkers(i)).Copy Destination:=Worksheets(i + 2).Range("A2")
End If
Next i
End Sub
 
Vote positif 0 Vote négatif
O

OTW

XLDnaute Nouveau
Re : Scinder un fichier en plusieurs onglets selon un critère d'une colonne

Si le VBA fonctionne très bien (encore merci), celui-ci ne répond pas à une de mes attentes sur un autre projet, de tableau de bord.

J'ai un fichier global (source), que j'extrait d'un Portail internet et qui contient un certain nombre de données.

L'une de ces données se retrouve dans l'exemple ci-joint, onglet 1.

Je n'ai pas reproduit mon tableau de bord, mais l'idée est que chaque nom a un certain nombre d'informations sur son onglet. Chaque mise à jour de l'onglet "source" met à jour les données de chaque "nom".

Ce que je souhaite, c'est que sur chaque onglet "nom", je puisse avoir une extraction, un tri sélectif, de l'onglet 1 de mon exemple, pour les données qui le concerne.
Ex : Dans l'onglet HK, n'avoir que le tri de ce qui concerne le nom HK et les 3 colonnes qui vont avec.

Je pourrais voir un autre tableau, avec le VBA, mais cela m'obligerait à faire plusieurs mises à jour, ce qui n'est pas l'idée pour un tableau que je voudrais dynamique.

D'avance merci.
 

Pièces jointes

  • tri nom.xlsx
    18.4 KB · Affichages: 33
Vote positif 0 Vote négatif
klin89

klin89

XLDnaute Accro
Re : Scinder un fichier en plusieurs onglets selon un critère d'une colonne

Bonjour OTW, le forum :)

A ajuster selon les besoins :
VB: 
Sub Création()
    Dim rng As Range, i As Long, e
    Application.ScreenUpdating = False
    Set rng = Sheets("Onglet 1").Range("C4").CurrentRegion
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To rng.Rows.Count
            If Not .exists(rng.Cells(i, 1).Value) Then
                Set .Item(rng.Cells(i, 1).Value) = _
                Union(rng.Rows(1), rng.Rows(i))
            Else
                Set .Item(rng.Cells(i, 1).Value) = _
                Union(.Item(rng.Cells(i, 1).Value), rng.Rows(i))
            End If
        Next
        For Each e In .keys
            If Not IsSheetExists(e) Then
                Sheets.Add(after:=Sheets(Sheets.Count)).Name = e
            End If
            Sheets(e).Cells(1).CurrentRegion.ClearContents
            .Item(e).Copy Sheets(e).Cells(1)
        Next
    End With
    Application.ScreenUpdating = True
End Sub

Function IsSheetExists(ByVal feuille As String) As Boolean
    On Error Resume Next
    IsSheetExists = Len(Sheets(feuille).Name)
End Function
klin89
 
Vote positif 0 Vote négatif
klin89

klin89

XLDnaute Accro
Re : Scinder un fichier en plusieurs onglets selon un critère d'une colonne

Re OTW,

Pour répondre au post #18, une déclinaison du code précédent :
VB: 
Option Explicit

Sub Création2()
Dim dico As Object, i As Long, txt As String, e, temp As String
    Application.ScreenUpdating = False
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    With Sheets(1).Range("A1").CurrentRegion
        For i = 2 To .Rows.Count
            txt = .Rows(i).Cells(4).Value & _
                  "," & .Rows(i).Cells(9).Value
            If Not dico.exists(txt) Then
                Set dico(txt) = Union(.Rows(1), .Rows(i))
            Else
                Set dico(txt) = Union(dico(txt), .Rows(i))
            End If
        Next
    End With
    For Each e In dico
        temp = Join$(Split(e, ","))
        If Not IsSheetExists(temp) Then
            Sheets.Add(after:=Sheets(Sheets.Count)).name = temp
        End If
        Sheets(temp).Cells.Clear
        dico(e).Copy Sheets(temp).Cells(1)
    Next
    Set dico = Nothing
    Application.ScreenUpdating = True
End Sub

Function IsSheetExists(feuille As String) As Boolean
    On Error Resume Next
    IsSheetExists = Len(Sheets(feuille).name)
    On Error GoTo 0
End Function
Pour répondre à la dernière question du post #24 :
Code: 
dico(e).Copy Sheets(temp).Cells(53,2)
klin89
 
Dernière édition:
Vote positif 0 Vote négatif
O

OTW

XLDnaute Nouveau
Re : Scinder un fichier en plusieurs onglets selon un critère d'une colonne

Merci Klin89, ça fonctionne très bien.

je cherchais quelque chose de plus "dynamique", c'est à dire qui mette à jour les fichiers seul dès mise à jour de l'onglet source par exemple, comme avec une formule matricielle.
Non non, je ne suis pas faignant :- )

le tableau qui était en exemple, est issu de mon fichier source dans lequel je suis allé hercher des données avec une matrice qui est : =INDEX(INDEX(NotifNoRDV;;{1.2.3.4});EQUIV(GRANDE.VALEUR(INDEX(NotifNoRDV;;1)-LIGNE(INDEX(NotifNoRDV;;1))/10^10;LIGNE(INDIRECT("1:"&LIGNES(NotifNoRDV))));INDEX(NotifNoRDV;;1)-LIGNE(INDEX(NotifNoRDV;;1))/10^10;0))

sauf que cela fonctionne avec des chiffres et pas des noms....
me suffirait de rajouter une colonne par personne concernée et de faire "x" tris.... ce qui n'est pas très à propos et aussi rapide qu'avec le code VBA proposé.

Donc, si une matrice existe, je suis preneur.


Sinon, Klin89, est-il possible de décider de l'emplacement sur la feuille de destination, exemple, début du tableau ligne 53 colonne B ?

OTW
 
Vote positif 0 Vote négatif

Discussions similaires

A
  • Résolu(e)
Microsoft 365 Trouver un critère en fonction d'une somme donnée
Réponses
5
Affichages
385
al.db
A
L
  • Résolu(e)
Microsoft 365 Macro copie de lignes entières d'un onglet général vers onglets détaillés à partir d'une colonne oui/non
Réponses
9
Affichages
1 K
job75
job75
F
  • Résolu(e)
Microsoft 365 Dispatcher feuille excel en plusieurs onglets - En gardant lignes d'Entête
Réponses
6
Affichages
2 K
mapomme
mapomme
E
  • Résolu(e)
XL 2013 Un onglet par critère
Réponses
4
Affichages
980
Ex Elle
E
P
  • Question
Autres reporter des lignes de plusieurs onglets en fonction d'un critère dans un autre onglet
2
Réponses
23
Affichages
2 K
BOISGONTIER
BOISGONTIER
P
  • Résolu(e)
XL 2016 Amélioration fichier client
Réponses
2
Affichages
1 K
Pabloc
P
C
  • Question
XL 2010 Macro pour chercher un onglet et s'y rendre
Réponses
5
Affichages
2 K
CestPasMoi
C
B
  • Question
XL 2013 Consolider plusieurs onglets excel en un seul
Réponses
0
Affichages
1 K
bouboubou
B
A
  • Question
[MACRO] Help créer un fichier pdf par onglet avec nom spécifique lié à une case
Réponses
1
Affichages
2 K
MK.
M
H
  • Question
Copie d'une plage précise entre onglets
Réponses
2
Affichages
948
huile
H

Membres actuellement en ligne

4 membres et 68 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 392
Messages
2 088 004
Membres
103 693
dernier inscrit
vincs