Discussion :

[maxime2935]

Bonjour à tous,
Je me sers super bien du code que vous m'aviez donné l'an passé, c'est super! J'arrive même à faire quelques modifs, c'est top!
Par contre, je suis bloqué sur un point : à la fin de ma feuille "GLOBAL", il y a des lignes que je n'ai pas envie que la macro prenne en compte pour dispatcher les élèves dans les autres feuilles. J'aimerais que la macro fasse son boulot que des lignes 3 à 110, et là, il me prend tout le document. Comment faire?
Je mets en pièce jointe le document, mais sans les noms bien sûr.
Merci d'avance pour votre aide!

[maxime2935]

Si quelqu'un peut m'aider... Merci!

[hyperion13]

Salut
Si la première mouture de votre classeur contenait des données, celle-ci n'en contient aucune !

[maxime2935]

Les données étant confidentielles, il m'a semblé opportun de tout effacer.
Pensant que vous n'en auriez pas besoin pour résoudre mon problème (la macro est bien lisible sur le fichier). Les cases vides ne vous permettent pas de me donner une piste?
Merci et bonne journée

[hyperion13]

re,
Je viens de lire ce fils. La toute 1ère pièce jointe que vous aviez déposé contenait une erreur au démarrage de la sub() en L4, donc elle est partie directement à la poubelle.
A condition de strictement respecter la casse

Code :

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

1
2
3
colonne G : Eveil - Flute - Clarinette - Trompette B - Percussions - Piano - Tuba - Trompette - Saxophone - Trombone
vs
Nom feuilles : Eveil - Flute - Clarinette - Trompette B - Percussions - Piano - Tuba - Trompette - Saxophone - Trombone

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
Sub DispatchFeuilles()
'References : Microsoft Scripting Runtime object library
Dim xlWbk As Workbook
Dim xlWsh As Worksheet, xlWshGlob As Worksheet
Dim rngGlob As Range, rngFM As Range, rngFiltre As Range, c As Range, rngTri As Range
Dim dicObj As Object
Dim i As Long, lastRowGlob As Long, lastColGlob As Long, lastRow As Long, lastCol As Long
 
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
End With
 
Set xlWbk = ThisWorkbook
Set xlWshGlob = xlWbk.Worksheets("GLOBAL")
 
For Each xlWsh In Worksheets
    If xlWsh.Name <> "GLOBAL" Then
        lastRow = xlWsh.Cells(xlWsh.Rows.Count, 1).End(xlUp).Row
        lastCol = xlWsh.Cells(2, xlWsh.Columns.Count).End(xlToLeft).Column
        xlWsh.Range(xlWsh.Cells(3, 1), xlWsh.Cells(lastRow, lastCol)).Clear
    End If
Next xlWsh
 
With xlWshGlob
    lastRowGlob = .Cells(.Rows.Count, 1).End(xlUp).Row
    lastColGlob = .Cells(2, .Columns.Count).End(xlToLeft).Column
    Set rngGlob = .Range(.Cells(2, 1), .Cells(lastRowGlob, lastColGlob))
End With
 
With rngGlob
    i = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Row
End With
With rngGlob
    Set dicObj = CreateObject("Scripting.Dictionary")
    Set rngFM = Range(Cells(2, 7).Offset(1), Cells(lastRowGlob, 7))
    For Each c In rngFM
        If dicObj.exists(c.Value) Then
        Else
            dicObj.Add c.Value, 0
            .AutoFilter
            .AutoFilter Field:=7, Criteria1:=c.Value
            If i > 0 Then
                Set rngFiltre = Range(Cells(i, 1), Cells(lastRowGlob, lastColGlob)).SpecialCells(xlCellTypeVisible)
                For Each xlWsh In Worksheets
                    If xlWsh.Name = "FM" & c.Value Then
                        lastRow = Worksheets("FM" & c.Value).Range("A" & Rows.Count).End(xlUp).Row + 1
                        rngFiltre.Copy Destination:=Worksheets("FM" & c.Value).Range("A" & lastRow)
                    End If
                    If xlWsh.Name <> "FM" & c.Value And xlWsh.Name <> "GLOBAL" And xlWsh.Name = c.Value Then
                        lastRow = Worksheets(c.Value).Range("A" & Rows.Count).End(xlUp).Row + 1
                        rngFiltre.Copy Destination:=Worksheets(c.Value).Range("A" & lastRow)
                    End If
                Next xlWsh
            Else
                MsgBox "Pas de ligne filtrée !", , "Aucune ligne trouvée"
                Exit Sub
            End If
        End If
    Next c
End With
 
xlWshGlob.AutoFilterMode = False
 
For Each xlWsh In Worksheets
    If xlWsh.Name <> "GLOBAL" Then
        lastRow = xlWsh.Cells(xlWsh.Rows.Count, 1).End(xlUp).Row
        lastCol = xlWsh.Cells(2, xlWsh.Columns.Count).End(xlToLeft).Column
        Set rngTri = xlWsh.Range(xlWsh.Cells(2, 1), xlWsh.Cells(lastRow, lastCol))
        With xlWsh.Sort
             .SortFields.Clear
             .SortFields.Add Key:=xlWsh.Range("I2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
             .SortFields.Add Key:=xlWsh.Range("A2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
             .SortFields.Add Key:=xlWsh.Range("B2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
             .SetRange rngTri
             .Header = xlYes
             .MatchCase = False
             .Orientation = xlTopToBottom
             .Apply
        End With
        xlWsh.Activate
        xlWsh.Range("A2").Select
    End If
Next xlWsh
 
xlWbk.Worksheets("GLOBAL").Activate
 
With Application
    .CutCopyMode = False
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
End With
End Sub