Trie special des colonnes

maval

XLDnaute Barbatruc
Bonjour

Je me trouve devant un petit problème, très simple je pense mais bon, voilà, je n'arrive pas à trouver comment faire.

Est-il possible de trier deux plages en même temps?

Je recherche a modifier mon code c'est à dire j'aimerais trier les colonnes "A5:F101 et K5:K101"
C'est il possible?
Voici mon Code:

Code:
Private Sub CommandButton4_Click()
'Range("A5:J104").Select
Range("A6:I101,L6:M101").Select
    ActiveWindow.ScrollRow = 1
    Selection.Sort Key1:=Range("J5"), Order1:=xlDescending, Key2:=Range("I5") _
        , Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom
    Range("K5:K104").Select
    Selection.Font.ColorIndex = 3
    Range("B4").Select
    Dim Plage As Range, i&, Cell As Range, Rng As Range

  On Error Resume Next
  Set Plage = Range("I5:I104")
  If IsEmpty(Plage) Then Exit Sub
  
  Application.ScreenUpdating = False
  
  For Each Cell In Plage
    For i = 1 To Plage.Count
      Set Rng = Cell.Offset(i)
      If Rng <> "" And Rng = Cell Then
        Cell.Interior.ColorIndex = 39
        Rng.Interior.ColorIndex = 39
        Exit For
      End If
    Next i
  Next Cell
End Sub
Je vous remercie de votre aide

Amicalement

MV
 

JCGL

XLDnaute Barbatruc
Re : Trie special des colonnes

Bonjour à tous,

Peux-tu essayer avec :

VB:
Sub CommandButton4_Click()
    Dim Plage As Range, i&, Cell As Range, Rng As Range


    Range("A5:M101").Sort Key1:=Range("J5"), Order1:=xlDescending, Key2:=Range("I5"), Order2:=xlDescending
    Range("K5:K104").Font.ColorIndex = 3
    Range("B4").Select


    On Error Resume Next
    Set Plage = Range("I5:I104")
    If IsEmpty(Plage) Then Exit Sub


    Application.ScreenUpdating = False


    For Each Cell In Plage
        For i = 1 To Plage.Count
            Set Rng = Cell.Offset(i)
            If Rng <> "" And Rng = Cell Then
                Cell.Interior.ColorIndex = 39
                Rng.Interior.ColorIndex = 39
                Exit For
            End If
        Next i
    Next Cell
End Sub

Un fichier sera nécessaire pour une tentative d'aide optimisée... Si cela ne convient pas...
A + à tous
 

Discussions similaires

Réponses
7
Affichages
551