Séparation de données d'une feuille en plusieurs feuilles

Question

J'ai un fichier ci-joint avec une feuille contenant un grand nombre de données sur 10 compteurs, je voudrais faire une macro qui sépare ces données en 10 feuilles différentes, une par compteur. La sélection se faisant par le nom du compteur. Je ne sais pas du tout comment faire. QQ1 pourrait m'aider? Merci par avance...

ThauThème · Accepted Answer

Re,

Le code modifié :

Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set OS = Worksheets("Données_Compteurs") 'définit l'onglet source OS
Application.DisplayAlerts = False 'masque les messages d'Excel
For I = Sheets.Count To 1 Step -1 'boucle inversée sur tous les onglet du classeur (du dernier au premier)
    'si le nom de l'onglet de la boucle n'est pas le nom de l'onglet source, supprime l'onglet
    If Sheets(I).Name <> OS.Name Then Sheets(I).Delete
Next I 'prochain onglet de la boucle
Application.DisplayAlerts = True 'affiche les message d'Excel
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes es lignes I du tableau des valeurs (en partant de la seconde)
    D(TV(I, 1)) = "" 'alimente le dicrionnaire D avec les données en colonne 1 du tableau des valeurs (le Compteur)
Next I 'prochaine ligne de la boucle
TMP = D.Keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublon
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments J du tableau temporaire TMP
    Worksheets.Add After:=Sheets(Sheets.Count) 'ajoute un nouvel onglet en dernière position
    Set OD = ActiveSheet 'définit l'onglet destination OD
    OD.Name = TMP(J) 'renomme l'onglet destination
    'récupère la première ligne du tableau des valeurs dans A1 redimensionnée de l'onglet destination
    OD.Range("A1").Resize(1, UBound(TV, 2)).Value = Application.Index(TV, 1)
    For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes es lignes I du tableau des valeurs (en partant de la seconde)
        If TV(I, 1) = TMP(J) Then 'condition : si la donnée ligne I colonne 1 de TV est égale à l'élément J de TMP
            Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
            'récupère la ligne I tableau des valeurs dans DEST redimensionnée
            DEST.Resize(1, UBound(TV, 2)).Value = Application.Index(TV, I)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
    OD.Columns(3).NumberFormat = "hh:mm" 'format de la colonne 3
Next J 'prochain élément de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

78chris · Answer

Pourquoi 10 feuilles et pas un simple filtre ...

ThauThème · Answer

Essaie comme ça : Sub Macro1() Dim OS As Worksheet 'déclare la variable OS (Onglet Source) Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs) Dim D As Object 'déclare la variable D (Dictionnaire) Dim I As Integer 'déclare la variable I (Incrément) Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire) Dim OD As Worksheet 'déclare la variable OD (Onglet Destination) Dim DEST As Range 'déclare la variable DEST (cellule de DESTination) Application.ScreenUpdating = False 'masque les rafraîchissements d'écran Set OS = Worksheets("Données_Compteurs") 'définit l'onglet source OS Application.DisplayAlerts = False 'masque les messages d'Excel For I = Sheets.Count To 1 Step -1 'boucle inversée sur tous les onglet du classeur (du dernier au premier) 'si le nom de l'onglet de la boucle n'est pas le nom de l'onglet source, supprime l'onglet If Sheets(I).Name &lt;&gt; OS.Name Then Sheets(I).Delete Next I 'prochain onglet de la boucle Application.DisplayAlerts = True 'affiche les message d'Excel TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D For I = 2 To UBound(TV, 1) 'boucle sur toutes es lignes I du tableau des valeurs (en partant de la seconde) D(TV(I, 1)) = "" 'alimente le dicrionnaire D avec les données en colonne 1 du tableau des valeurs (le Compteur) Next I 'prochaine ligne de la boucle TMP = D.Keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublon For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments J du tableau temporaire TMP Worksheets.Add After:=Sheets(Sheets.Count) 'ajoute un nouvel onglet en dernière position Set OD = ActiveSheet 'définit l'onglet destination OD OD.Name = TMP(J) 'renomme l'onglet destination 'récupère la première ligne du tableau des valeurs dans A1 redimensionnée de l'onglet destination OD.Range("A1").Resize(1, UBound(TV, 2)).Value = Application.Index(TV, 1) For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes es lignes I du tableau des valeurs (en partant de la seconde) If TV(I, 1) = TMP(J) Then 'condition : si la donnée ligne I colonne 1 de TV est égale à l'élément J de TMP Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST 'récupère la ligne I tableau des valeurs dans DEST redimensionnée DEST.Resize(1, UBound(TV, 2)).Value = Application.Index(TV, I) End If 'fin de la condition Next I 'prochaine ligne de la boucle 2 Next J 'prochain élément de la boucle 1 Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran End Sub...

78chris · Answer

RE à tous Rien n'empêche en l'état d'analyser par TCD ou PowerQuery. Au contraire on peut même facilement faire des comparaisons entre compteurs en plus...