Tri sur ligne puis colonne

Bonjour le forum,

Voici mon problème :

J'ai une feuille "Dépenses" sur laquelle j'ajoute des catégories.

Je souhaiterais que quand je clique sur le bouton "Trier", le "tableau" tri :

*d'une part la ligne 1 alphabétiquement de la colonne A à la dernière colonne non vide.

*d'autre part le "tableau de la ligne 2 à la dernière ligne non vide du tableau.

Ci-joint le fichier. Merci

J'ai réussi en faisant ceci (dans la limite ou je n'ai pas plus de 49 lignes par catégorie).

Sub Rectangle1_Cliquer()
Dim DerLigne As Integer
Dim DerColonne As Integer
Dim NumColonne As Integer

DerColonne = Sheets("Dépenses").Cells(1, Cells.Columns.Count).End(xlToLeft).Column
Application.ScreenUpdating = False

For NumColonne = 1 To DerColonne
DerLigne = Sheets("Dépenses").Cells(Cells.Rows.Count, NumColonne).End(xlUp).Row
Sheets("Dépenses").Range(Cells(2, NumColonne), Cells(DerLigne, NumColonne)).Select
ActiveWorkbook.Worksheets("Dépenses").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Dépenses").Sort.SortFields.Add Key:=Cells(2, NumColonne), _
         SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Dépenses").Sort
        .SetRange Range(Cells(2, NumColonne), Cells(DerLigne, NumColonne))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Next NumColonne

Range(Columns(1), Columns(DerColonne)).Select
    ActiveWorkbook.Worksheets("Dépenses").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Dépenses").Sort.SortFields.Add Key:=Range(Cells(1, 1), Cells(1, DerColonne)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Dépenses").Sort
        .SetRange Range(Cells(1, 1), Cells(50, DerColonne))
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With

Application.ScreenUpdating = True
End Sub

Si ça peut aider quelqu'un :

Private O As Worksheet 'déclare la variable O (Onglet)

Sub Rectangle1_Cliquer()
Dim DerLigne As Integer
Dim DerColonne As Integer
Dim NumColonne As Integer

If Sheets("Accueil").Range("D5").Value = 0 Then
Set O = Worksheets("Dépenses") 'définit l'onglet O
Else: Sheets("Accueil").Range("D5").Value = 1
Set O = Worksheets("Revenus") 'définit l'onglet O
End If

DerColonne = O.Cells(1, Cells.Columns.Count).End(xlToLeft).Column
Application.ScreenUpdating = False

For NumColonne = 1 To DerColonne
DerLigne = O.Cells(Cells.Rows.Count, NumColonne).End(xlUp).Row
O.Select
O.Range(Cells(2, NumColonne), Cells(DerLigne, NumColonne)).Select
O.Sort.SortFields.Clear
O.Sort.SortFields.Add Key:=Cells(2, NumColonne), _
         SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With O.Sort
        .SetRange Range(Cells(2, NumColonne), Cells(DerLigne, NumColonne))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Next NumColonne

iCol = Cells(1, Columns.Count).End(xlToLeft).Column
For x = 1 To iCol
    iRow = Cells(Rows.Count, x).End(xlUp).Row
    sCol = Split(Columns(x).Address(ColumnAbsolute:=False), ":")(1)
    Select Case iRow
        Case Is > iPlus
            iPlus = iRow
            sMsg = sCol
        Case Is = iPlus
            sMsg = sMsg & " " & sCol
    End Select
Next

Range(Cells(1, 1), Cells(iPlus, DerColonne)).Select
    O.Sort.SortFields.Clear
    O.Sort.SortFields.Add Key:=Range(Cells(1, 1), Cells(1, DerColonne)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With O.Sort
        .SetRange Range(Cells(1, 1), Cells(iPlus, DerColonne))
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With

Application.ScreenUpdating = True
End Sub

Salut Benoist,

au lieu de le dire plus tôt! Mais, bel effort!

Attention cependant à l'enregistreur de macro, trop généreux en lignes de code...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
If Target.Row = 1 Then
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    '
    iCol = Cells(1, Columns.Count).End(xlToLeft).Column
    sCol = Split(Columns(iCol).Address(ColumnAbsolute:=False), ":")(1)
    '
    For x = 1 To iCol
        iRow = Cells(Rows.Count, x).End(xlUp).Row
        sCol1 = Split(Columns(x).Address(ColumnAbsolute:=False), ":")(1)
        If iRow > iPlus Then iPlus = iRow
        Range(sCol1 & "2:" & sCol1 & iRow).Sort _
                        key1:=Range(sCol1 & "2"), order1:=xlAscending, Orientation:=xlTopToBottom
    Next
    '
    Range("A1:" & sCol & iPlus).Sort key1:=Range("A1"), order1:=xlAscending, Orientation:=xlLeftToRight
    Range("A2:" & sCol & iPlus).Interior.Color = xlNone
    For x = 2 To iPlus
        Range("A" & x & ":" & sCol & x).Interior.Color = IIf(x Mod 2 = 0, xlNone, RGB(215, 215, 215))
    Next
    '
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End If
'
End Sub

A+

Salut curulis57,

au lieu de le dire plus tôt! Mais, bel effort!

C'était dans le titre,

Un grand merci pour ton code, plus rapide et plus propre.

Amicalement

Benoist