Macro liste classée par ordre alphabétique

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