XL 2010 Trier vers un onglet défini

elmilo13

XLDnaute Nouveau
Bonjour à tous,

Je suis novice dans le paramétrage des Macros.
Après avoir passé plusieurs heures à chercher, je vous expose mon problème.

J'ai un tableau de données assez conséquent où j'ai pu trouver une macro qui me tri par nom sur des onglets différents afin d'avoir une synthèse par personne.
Le problème est que les onglets sur lesquels sont réalisés les tris, sont des onglets vierges. Or j'aimerai que le tri se fasse sur un modèle d'onglet contenant des tableau et des graphes permettant d'obtenir un tableau de bord en un click par personne !

Voici la macro que j'utilise. Les données à traiter sont sur la Feuil1.

Comment faire pour définir l'onglet de destination ?

Merci de votre aide.



VB:
[CODE=vb]Sub TrierVersOnglets()

' Definir le nom des onglets pour rendre les traitements plus rapides

Dim wsMain As Object    ' L'onglet contenant le tableau à trier

Dim wsDest As Object    ' L'onglet de destination



Dim tabMain()           ' Tableau pour enregistrer en memoire les donnees de l'onglet a trier



Dim ligDeb, ligFin      ' LIGne de DEBut, LIGnde de FIN

Dim colDeb, colFin      ' COLonne de DEBut, COLonne de FIN

Dim cptLig, cptCol      ' ComPTeur de LIGne, ComPTeur de COLonne



    Application.ScreenUpdating = False  ' Interdire les affichage pour aller plus vite

    

    Set wsMain = Worksheets("Feuil1")   ' Definir le nom de l'onglet contenant le tableau à trier

    

    With wsMain         ' Selectionner l'onglet contenant le tableau à trier

        ligDeb = 2

        colDeb = 1

        ligFin = .Cells(Rows.Count, colDeb).End(xlUp).Row   ' Aller a la dernier ligne Excel (Rows.Count) et remonter a la la dernire ligne non vide (End(xlUp))

        colFin = 32

        tabMain = Range(.Cells(ligDeb, colDeb), .Cells(ligFin, colFin)) ' Charger les donnees dans le tableau

    End With

    

    ' POUR chacune des LIGnes de ComPTeur du tableau des donnees (ligne parce que Ubound(tabMain,1) donne la dimension du tableau en hauteur)

    For cptLig = 1 To UBound(tabMain, 1)

        If ExisteOnglet(tabMain(cptLig, 1)) Then                       ' Si l'onglet du NOM existe

            Set wsDest = Worksheets(tabMain(cptLig, 1))                '   Definir cet onglet

            With wsDest                                                 '   Selectionner cet onglet

                ligFin = .Cells(Rows.Count, 1).End(xlUp).Row + 1        '   Chercher la derniere ligne

                ' Pour chaque COLonne de ComPTeur du tableau des donnees (ligne parce que Ubound(tabMain,2) donne la dimension du tableau en largeur)

                For cptCol = 1 To UBound(tabMain, 2)

                    .Cells(ligFin, cptCol) = tabMain(cptLig, cptCol)    ' Afficher dans le bon onglet (grace a .Cells) la valeur du tableau

                Next

            End With

            Set wsDest = Nothing

        End If

    Next

    

    wsMain.Activate

    

    Set wsMain = Nothing

    

    Application.ScreenUpdating = True

    

End Sub



Function ExisteOnglet(lequel) As Boolean

Dim bidon



    ' au debut on suppose que l'onglet existe

    ' mais au cas où on met en place une gestion des erreurs

    On Error GoTo notExisteOnglet

    ' on cherche a affecter la valeur de la premiere cellule de l'onglet en qustion dans une variable BIDON

    '   si il y a une erreur -> cela veut dire que l'onglet nexiste pas DONC branchement vers l'etiquette notExisteOnglet puisqu'il nexiste pas

    bidon = Worksheets(lequel).Cells(1, 1)

    ' Debrancher le traitement des erreurs !!! ne jamais oublier !!!

    On Error GoTo 0

    ExisteOnglet = True ' L'onglet existe ! et cela dans tous les cas !!!

    

    ' Sortir de la fonction pour ne pas le recreer une deuxieme fois !

    Exit Function

    

notExisteOnglet:

    ' comme l'onglet n'existait pas... nous le creeons !

    Sheets.Add After:=Worksheets("Feuil1")

    ' nous le renommons

    ActiveSheet.Name = lequel

    ' Revenir (juste) apres la ligne qui a generee l'erreur !

    Resume Next

    

End Function
[/CODE]
 

job75

XLDnaute Barbatruc
Voyez le fichier joint et cette macro :
VB:
Sub TrierVersOnglets()
Dim i&, d As Object, tablo, nom$
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'---supprime les feuilles---
For i = Sheets.Count To 2 Step -1
    Sheets(i).Delete
Next
'---crée les feuilles---
Set d = CreateObject("Scripting.Dictionary")
ActiveSheet.DrawingObjects.Placement = 3
With [A1].CurrentRegion
    tablo = .Value 'matrice, plus rapide
    For i = 2 To UBound(tablo)
        nom = tablo(i, 1)
        If Not d.exists(nom) Then
            d(nom) = ""
            Sheets.Add After:=Sheets(Sheets.Count) 'nouvelle feuille
            ActiveSheet.Name = nom
            .AutoFilter 1, nom 'filtre automatique
            .Copy [A1] 'copier-coller
            Columns("A:B").AutoFit 'ajuste les largeurs
        End If
    Next
End With
Sheets(1).Activate
If Sheets(1).FilterMode Then Sheets(1).ShowAllData 'affiche tout
End Sub
 

Pièces jointes

  • 2020_RH_TLBM TEST(1).xlsm
    23.3 KB · Affichages: 10

Discussions similaires