Bonjour,

J'ai 2 petits soucis avec un script que j'essaye de finaliser.

En gros voici la logique de mon script :

Il trie les "niveaux d'accès", dès qu'il tombe sur un nouveau niveau d'accès, il créé une nouvelle feuille, il nomme la feuille avec le nom du "niveau d'accès" en cours, il revient sur la feuille source, prend les données que je veux dans des variables, et reswitch sur la feuille de destination pour coller les données à la ligne.

ensuite il se deplace et compare la celulle du dessus, avec la cellule du dessous, pour vérifier si ce sont les mêmes; si ce sont les mêmes, il copie colle la ligne dans la feuille déjà existante.

Si les niveaux d'accès comparés ne sont pas les mêmes il créé une nouvelle feuille excell avec le nom actuel du niveau d'accès, et continu en copiant collant les ligne correspondant à ce "niveau d'accès".

J'ai 2 bugs :

Un qui en fait ce produit lorsque je suis touuuut à la fin du tableau (de 2800 lignes), je crois qu'il compare une cellule vide (la derniere après le tableau) avec la cellule précedente, et du coup j'ai une erreur débogage. mais c'est un faux positif puisqu'il a bien fait tout le travail. c'est un bug de fin de script.

et le 2 eme bug c'est que : par exemple si j'ai un groupe A avec 10 personnes et un groupes B avec 15 personnes : le script va donc créé une feuille A et B ensuite. le problème c'est que la Première personne du groupe B se retrouve à la derniere ligne de la feuille A, au lieu de se retrouver normalement à la premiere place de la feuille B.

voilà le code (attention ca pique les yeux, je suis débutant en VBA ^^)

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
Sub TRIEAUTODROITSBADGES()
    ' Constants
    Const SourceSheet = "Niveaux d'accès - Personnes"
    Const AccessLevelTitle = "C1"
    Const AccessLevelTitleName = "Nom niveau d'accès"
    Const LastNameTitle = "A1"
    Const LastNameTitleName = "Nom"
    Const FirstNameTitle = "B1"
    Const FirstNameTitleName = "Prénom"
    Const WorkGroupTitle = "D1"
    Const WorkGroupTitleName = "Nom groupe de travail"
 
    ' Exploring variables.
    Dim CurrentAccessLevel As String
    Dim PreviousAccessLevel As String
    Dim SourceOffset As Integer
    Dim IntermediateOffset As Integer
    Dim DestinationOffset As Integer
    Dim ExitStoringLoop As Boolean
    Dim DestinationSheet As String
 
    ' Content variables.
    Dim CurrentLastName As String
    Dim CurrentFirstName As String
    Dim CurrentWorkGroup As String
 
    ' Initialization.
    Sheets(SourceSheet).Select
    Range(AccessLevelTitle).Select
    ActiveCell.Offset(1, 0).Select
    CurrentAccessLevel = ActiveCell.Value
    PreviousAccessLevel = ""
    DestinationSheet = ""
    SourceOffset = 1
    IntermediateOffset = 0
    DestinationOffset = 1
    ExitStoringLoop = False
    CurrentLastName = ""
    CurrentFirstName = ""
    CurrentWorkGroup = ""
 
    ' Exploration loop.
    While ((Not IsEmpty(CurrentAccessLevel)))
        ' Excluding duplicated values.
        If (CurrentAccessLevel <> PreviousAccessLevel) Then
            PreviousAccessLevel = CurrentAccessLevel
            ' Prepare Extract loop.
            IntermediateOffset = 0
            ' Extract loop.
            While (CurrentAccessLevel = PreviousAccessLevel)
                ' Retrieve data to extract.
                Sheets(SourceSheet).Select
                Range(LastNameTitle).Select
                    ActiveCell.Offset(SourceOffset + IntermediateOffset, 0).Select
                    CurrentLastName = ActiveCell.Value
                Range(FirstNameTitle).Select
                    ActiveCell.Offset(SourceOffset + IntermediateOffset, 0).Select
                    CurrentFirstName = ActiveCell.Value
                Range(WorkGroupTitle).Select
                    ActiveCell.Offset(SourceOffset + IntermediateOffset, 0).Select
                    CurrentWorkGroup = ActiveCell.Value
                ' Check the destination sheet existence.
                DestinationSheet = "" & CurrentAccessLevel
                SheetExists = False
                For Each Ws In Worksheets
                    If (DestinationSheet = Ws.Name) Then
                        SheetExists = True
                    End If
                Next Ws
                If (SheetExists = False) Then
                    ' Add a new sheet at the end of the workbook if it does not exist.
                    Sheets.Add After:=Sheets(Sheets.Count)
                    ActiveSheet.Name = DestinationSheet
                    ' Define the cells titles.
                    Range(AccessLevelTitle).Select
                    ActiveCell.Value = AccessLevelTitleName
                    Range(LastNameTitle).Select
                    ActiveCell.Value = LastNameTitleName
                    Range(FirstNameTitle).Select
                    ActiveCell.Value = FirstNameTitleName
                    Range(WorkGroupTitle).Select
                    ActiveCell.Value = WorkGroupTitleName
                End If
                ' Prepare storing loop.
                DestinationOffset = 0
                ExitStoringLoop = False
                ' Storing loop.
                While (ExitStoringLoop <> True)
                        Sheets(DestinationSheet).Select
                            ' Select destination cell.
                            Range(AccessLevelTitle).Select
                            ActiveCell.Offset(DestinationOffset, 0).Select
                            ' Check if the destination cell is well empty
                            If (IsEmpty(ActiveCell.Value)) Then
                                ' Store the new extracted value.
                                ActiveCell.Value = CurrentAccessLevel
                                Range(LastNameTitle).Select
                                    ActiveCell.Offset(DestinationOffset, 0).Select
                                    ActiveCell.Value = CurrentLastName
                                Range(FirstNameTitle).Select
                                    ActiveCell.Offset(DestinationOffset, 0).Select
                                    ActiveCell.Value = CurrentFirstName
                                Range(WorkGroupTitle).Select
                                    ActiveCell.Offset(DestinationOffset, 0).Select
                                    ActiveCell.Value = CurrentWorkGroup
                                ExitStoringLoop = True
                            End If
                            ' Switch to the next destination cell.
                            DestinationOffset = DestinationOffset + 1
                Wend
                ' Switch to the next value inner access level scope.
                Sheets(SourceSheet).Select
                Range(AccessLevelTitle).Select
                ActiveCell.Offset(SourceOffset + IntermediateOffset, 0).Select
                CurrentAccessLevel = ActiveCell.Value
                Rows(1).EntireRow.Delete
            Wend
            ' Update the source offset with the intermediate offset.
            SourceOffset = SourceOffset + IntermediateOffset - 1
        End If
        ' Switch to the next value.
        Sheets(SourceSheet).Select
        Range(AccessLevelTitle).Select
        SourceOffset = SourceOffset + 1
        ActiveCell.Offset(SourceOffset, 0).Select
        CurrentAccessLevel = ActiveCell.Value
    Wend
End Sub
Voilà, j'espère avoir été assez clair les amis.

j'espere que vous pourrez m'aider,

je suis à votre disposition pour toute information complémentaire.

Cordialement,