[ RESOLU ] Classer les plus grosses valeurs negatives,et

Private Sub CommandButton1_Click()
Dim c As Range, i As Variant
Application.ScreenUpdating = False
For Each c In Intersect([B:B], Me.UsedRange.EntireRow)
  If c = "N°" Then
    c.Resize(21, 5).Copy c(1, 9)
    c.Resize(, 5).Copy c(22, 9) '2ème ligne de titres
    With c(1, 9).Resize(22, 5)
      For i = 2 To 21
        If .Cells(i, 5) = 0 Then .Cells(i, 1).Resize(, 5) = "": _
          .Cells(i, 1).Resize(, 5).Interior.ColorIndex = xlNone
      Next
      .Sort .Columns(5), xlAscending, Header:=xlYes '1er tri
      i = Application.Match(0, .Columns(5))
      If IsError(i) Then i = 1 'si aucune valeur < 0
      .Cells(i + 1, 1).Resize(22 - i, 5) _
        .Sort .Columns(5), xlDescending, Header:=xlNo '2ème tri
    End With
  End If
Next
End Sub

Private Sub CommandButton1_Click()
Dim c As Range, i&
Application.ScreenUpdating = False
For Each c In Intersect([B:B], Me.UsedRange.EntireRow)
  If c = "N°" Then
    c.Resize(21, 5).Copy c(1, 9)
    c.Resize(, 5).Copy c(22, 9) '2ème ligne de titres
    With c(1, 9).Resize(22, 5)
      For i = 2 To 21
        If .Cells(i, 5) = 0 Then .Cells(i, 1).Resize(, 5) = "": _
          .Cells(i, 1).Resize(, 5).Interior.ColorIndex = xlNone
      Next
      .Sort .Columns(5), xlAscending, Header:=xlYes '1er tri
      i = Application.CountIf(.Columns(5), "<0") + 2
      .Cells(i, 1).Resize(23 - i, 5) _
        .Sort .Columns(5), xlDescending, Header:=xlNo '2ème tri
    End With
  End If
Next
End Sub

Private Sub CommandButton1_Click()
Dim c As Range, i&
Application.ScreenUpdating = False
For Each c In Intersect([B:B], Me.UsedRange.EntireRow)
  If c = "N°" Then
    c.Resize(21, 5).Copy c(1, 11)
    c.Resize(, 5).Copy c(22, 11) '2ème ligne de titres
    With c(1, 11).Resize(22, 5)
      For i = 2 To 21
        If .Cells(i, 2) = 0 Then .Cells(i, 1).Resize(, 5) = "": _
          .Cells(i, 1).Resize(, 5).Interior.ColorIndex = xlNone
      Next
      .Sort .Columns(2), xlAscending, Header:=xlYes '1er tri
      i = Application.CountIf(.Columns(2), "<0") + 2
      .Cells(i, 1).Resize(23 - i, 5) _
        .Sort .Columns(2), xlDescending, Header:=xlNo '2ème tri
    End With
  End If
Next
End Sub

Private Sub CommandButton1_Click()
Classement 2
End Sub

Private Sub CommandButton2_Click()
Classement 5
End Sub

Private Sub Classement(col%)
Dim c As Range, i&
Application.ScreenUpdating = False
For Each c In Intersect([B:B], Me.UsedRange.EntireRow)
  If c = "N°" Then
    c.Resize(21, 5).Copy c(1, 11)
    c.Resize(, 5).Copy c(22, 11) '2ème ligne de titres
    With c(1, 11).Resize(22, 5)
      For i = 2 To 21
        If .Cells(i, col) = 0 Then .Rows(i) = "": .Rows(i).Interior.ColorIndex = xlNone
      Next
      .Sort .Columns(col), xlAscending, Header:=xlYes '1er tri
      i = Application.CountIf(.Columns(col), "<0") + 2
      .Rows(i).Resize(23 - i).Sort .Columns(col), xlDescending, Header:=xlNo '2ème tri
    End With
  End If
Next
End Sub

Private Sub Classement(col%)
Dim c As Range, i&, Nmoins&, Nplus&
Application.ScreenUpdating = False
For Each c In Intersect([B:B], Me.UsedRange.EntireRow)
  If c = "N°" Then
    c.Resize(21, 5).Copy c(1, 11)
    c.Resize(, 5).Copy c(22, 11) '2ème ligne de titres
    With c(1, 11).Resize(22, 5)
      For i = 2 To 21
        If .Cells(i, col) = 0 Then .Rows(i) = "": .Rows(i).Interior.ColorIndex = xlNone
      Next
      .Sort .Columns(col), xlAscending, Header:=xlYes '1er tri
      Nmoins = Application.CountIf(.Columns(col), "<0")
      Nplus = Application.CountIf(.Columns(col), ">0")
      i = Nmoins + 2
      .Rows(i).Resize(23 - i).Sort .Columns(col), xlDescending, Header:=xlNo '2ème tri
      '---colonnes H I J---
      c(0, 7).Resize(2, 3) = IIf(col = 2, [{"O","V","E";"V N","","VP"}], [{"D","E","R";"DN","","DP"}])
      c(2, 7).Resize(2, 3) = "" 'RAZ
      If Nmoins Then
        i = IIf(col = 2, 1 + Nmoins, 2)
        c(2, 7) = .Cells(i, 1)
        c(3, 7) = .Cells(i, col)
      End If
      If Nplus Then
        i = IIf(col = 2, 2 + Nmoins + Nplus, 3 + Nmoins)
        c(2, 9) = .Cells(i, 1)
        c(3, 9) = .Cells(i, col)
      End If
    End With
  End If
Next
End Sub

Private Sub CommandButton1_Click()
Classement 2
[A:P].Copy [R1]
Classement 5
End Sub

Private Sub Classement(col%)
Dim c As Range, i&, Nmoins&, Nplus&
Application.ScreenUpdating = False
For Each c In Intersect(IIf(col = 2, [B:B], [S:S]), Me.UsedRange.EntireRow)
'------
Next
End Sub