Macro liste classée par ordre alphabétique

  • Initiateur de la discussion Initiateur de la discussion LOLO13130
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

LOLO13130

XLDnaute Nouveau
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 :
Code:
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
 
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
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
45
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
482
Réponses
3
Affichages
569
Réponses
9
Affichages
367
Réponses
4
Affichages
332
Réponses
7
Affichages
533
Retour