Microsoft 365 Macro tri des lignes

[Chris Linefield]

Bonjour tout le monde,

Je viens vers vous car je rencontre un petit problème avec mon fichier excel qui fonctionnait très bien, mais depuis quelques semaines déconne. Il me sort ce message d'erreur :

Avez-vous une petite idée de mon erreur ? Ci-joint le VBA.

Private Sub Worksheet_change(ByVal Target As Range)

Dim ligne As Integer
    If Not Intersect(Target, Range("I:M")) Is Nothing Then
        ligne = Target.Row
        If Range("I" & ligne) = "" And Range("C" & ligne) <> "" Then
            MsgBox ("Veuillez entrer une date de demande")
        Else
            Columns("B:B").Select
            ActiveWorkbook.Worksheets("Activités").Sort.SortFields.Clear
            ActiveWorkbook.Worksheets("Activités").Sort.SortFields.Add Key:= _
                Range("B3:B500"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder _
                :="En attente,A planifier,En cours, Finalisé", DataOption:=xlSortNormal
            ActiveWorkbook.Worksheets("Activités").Sort.SortFields.Add Key:= _
                Range("A3:A500"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
                :=xlSortNormal
            ActiveWorkbook.Worksheets("Activités").Sort.SortFields.Add Key:= _
                Range("E3:E500"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
                xlSortNormal
            With ActiveWorkbook.Worksheets("Activités").Sort
                .SetRange Range("A2:R500")
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            Target.Select
            Rows("3:200").EntireRow.AutoFit
            If Cells.Find(What:="finalisé", After:=ActiveCell, LookIn:=xlValues, LookAt _
                :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                False, SearchFormat:=False) Is Nothing Then
                Exit Sub
                Else
                Cells.Find(What:="finalisé", After:=ActiveCell, LookIn:=xlValues, LookAt _
                    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                    False, SearchFormat:=False).Activate
        
                ligne = ActiveCell.Row
                Rows(ligne).Select
                Selection.Copy
                Call copy_paste
                Rows("3:200").EntireRow.AutoFit
            End If

        End If
        Else:
        Target.Select
        Exit Sub
    
    End If
    
  
    
End Sub

 

[Compte Supprimé 979]

Bonjour Chris,

L'objet conteneur n'est pas définit dans les Range(), je ferais comme ceci

Private Sub Worksheet_change(ByVal Target As Range)
  Dim Sht As Worksheet
  Dim ligne As Integer
  If Not Intersect(Target, Range("I:M")) Is Nothing Then
    Set Sht = ActiveWorkbook.Worksheets("Activités")
    ligne = Target.Row
    If Range("I" & ligne) = "" And Range("C" & ligne) <> "" Then
      MsgBox ("Veuillez entrer une date de demande")
    Else
      Columns("B:B").Select
      With Sht.Sort
        With .SortFields
          .Clear
          .Add Key:=Sht.Range("B3:B500"), SortOn:=xlSortOnValues, Order:=xlAscending, _
    CustomOrder:="En attente,A planifier,En cours, Finalisé", DataOption:=xlSortNormal
          .Add Key:=Sht.Range("A3:A500"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
          .Add Key:=Sht.Range("E3:E500"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        End With
        .SetRange Sht.Range("A2:R500")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
      End With
      Target.Select
      Sht.Rows("3:200").EntireRow.AutoFit
      If Cells.Find(What:="finalisé", After:=ActiveCell, LookIn:=xlValues, LookAt _
                    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                    False, SearchFormat:=False) Is Nothing Then
        Exit Sub
      Else
        Cells.Find(What:="finalisé", After:=ActiveCell, LookIn:=xlValues, LookAt _
                   :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                   False, SearchFormat:=False).Activate
        
        ligne = ActiveCell.Row
        Rows(ligne).Select
        Selection.Copy
        Call copy_paste
        Rows("3:200").EntireRow.AutoFit
      End If
    End If
  Else:
    Target.Select
    Exit Sub
  End If
End Sub

A+

 

[Chris Linefield]

Je test ça dans la journée, merci de ta réponse @BrunoM45 !

 

[Chris Linefield]

Malheureusement j'ai toujours l'erreur. Laisse moi être plus précis sur mon problème.
J'ai un tableau avec des data, lorsque j'applique un tri dans l'une des cases (ici l'erreur se déclare lorsque je tri la colonne H) tout va bien, le tri fonctionne et tout va bien, cependant lorsque je souhaite mettre une date dans l'une des colonnes, l'erreur apparait de nouveau et mon excel plante.
As-tu une solution @BrunoM45 ?

 

[Compte Supprimé 979]

Re,

Merci de joindre un fichier sans données personnelles SVP

 

[Chris Linefield]

J'ai trouvé le problème !
J'ai simplement limiter la zone à trier en dehors de la variable colonne.

Merci pour le coup de main Bruno !