Macro liste classée par ordre alphabétique

[LOLO13130]

Bonsoir à tous,
étant débutant sur excel (en vba surtout), mapomme m'a très gentiment écrit une macro pour réaliser une liste classée par ordre alphabétique dans la feuille "Présences B-J1", à partir de 2 feuilles ("Benjamines" puis "Benjamins") sous 2 conditions ("E1" dans la colonne D ET "OUI" dans la colonne G).

Pouvez-vous m'aider à résoudre 2 problèmes s'il-vous-plaît..? cela dépasse vraiment mes compétences...

Problème n°1 : je souhaiterai créer la même liste classée par ordre alphabétique dans la feuille "Présences B-J1", mais sous des conditions différentes ("E1" OU "E2" OU "E3" OU "E4" OU "E5" dans la colonne D ET "OUI" dans la colonne G).

Problème n°2 : je souhaiterai créer une liste classée par ordre alphabétique dans la feuille "Présences MC-J1", mais à partir de 4 feuilles cette fois ("Minimes FILLES" puis "Minimes GARÇONS" puis "Cadettes" puis "Cadets") sous 2 conditions ("E1" dans la colonne D ET "OUI" dans la colonne G).

Voici la macro à adapter :

Sub BilanBFBG_E1()
Dim derlig&, source, i&, j&, n&, etab, k&, m&

'prépa
Application.ScreenUpdating = False
With Sheets("Présences B-J1")
  .Range("a3:c" & .Rows.Count).ClearContents
  .Range("a3:c" & .Rows.Count).Interior.Color = xlNone
  etab = .Cells(1, "b")
End With

'Benjamine
With Sheets("Benjamines")
  derlig = .Cells(.Rows.Count, "a").End(xlUp).Row
  If derlig >= 6 Then
    source = .Range("a6:g" & derlig).Value
    For i = 1 To UBound(source)
      If source(i, 4) <> etab Or source(i, 7) <> "OUI" Then source(i, 1) = "à_suppr"
    Next i
    k = 0
    For i = 1 To UBound(source)
      If source(i, 1) <> "à_suppr" Then
        k = k + 1
        For j = 1 To 3: source(k, j) = source(i, j): Next j
      End If
    Next i
    If k > 0 Then
      With Sheets("Présences B-J1")
        .Range("a3").Resize(k, 3) = source
        .Range("a3").Resize(k, 3).Sort key1:=.Range("a3"), order1:=xlAscending, Header:=xlNo
        .Range("a3").Resize(k, 3).Interior.Color = RGB(255, 133, 238)
      End With
    End If
  End If
End With

'Benjamin
With Sheets("Benjamins")
  derlig = .Cells(.Rows.Count, "a").End(xlUp).Row
  If derlig >= 6 Then
    source = .Range("a6:g" & derlig).Value
    For i = 1 To UBound(source)
      If source(i, 4) <> etab Or source(i, 7) <> "OUI" Then source(i, 1) = "à_suppr"
    Next i
    m = 0
    For i = 1 To UBound(source)
      If source(i, 1) <> "à_suppr" Then
        m = m + 1
        For j = 1 To 3: source(m, j) = source(i, j): Next j
      End If
    Next i
    If m > 0 Then
      With Sheets("Présences B-J1")
        .Range("a3").Offset(k).Resize(m, 3) = source
        .Range("a3").Offset(k).Resize(m, 3).Sort key1:=.Range("a3").Offset(k), order1:=xlAscending, Header:=xlNo
        .Range("a3").Offset(k).Resize(m, 3).Interior.Color = RGB(141, 192, 235)
      End With
    End If
  End If
End With

End Sub

Merci d'avance à ceux qui prendront le temps de m'aider et au forum pour son efficacité !
Laurent

 

[mapomme]

Bonjour LOLO13130,

Il manque le fichier joint avec les bons onglets 🙁

 

[LOLO13130]

Bonjour mapomme et le forum,

Un grand merci de prendre à nouveau le temps de me répondre. En bidouillant, j'ai un fichier qui répond à mes besoins mais qui peut s'en doute être amélioré...
Je joins le fichier final si tu peux m'indiquer quelles sont mes voies d'amélioration s'il-te-plaît..? notamment sur le nombre de modules créés qui est sûrement réductible et sur les listes alphabétiques dans les feuilles "Présences E-J1" et "Présences E-J2" qui ont perdu leur mise en forme selon la catégorie...

Si tu (ou un membre du forum) n'as pas le temps de te pencher sur la question, encore merci pour tout !!
Laurent