Trier et ajouter automatiquement un tableau

[achkar]

Bonjour a tous,
d'après l'aide de Skoobi et après plusieurs jours de recherche, j'ai réussi de mettre un message d'erreur s'il y a des boublant mais, j'ai une nouvelle question à vous poser ?


Le problème :

Quand j'ajoute une ligne avec les mêmes données dans les colonnes "A" et "B" des feuilles 2 et 3, avec des modifications dans les colonnes "C" et/ou "D",
il n'y a qu'une seule ligne qui s'ajoute dans la feuille 1. Tout en sachant que ils ne doivent
pas avoir le meme contenu dans la cellule "B" de la feuille 1 ( c-à-d. feuille 2 pour
la fueille 2 et feuille 3 pour la feuille 3 ).

voir le fichier attachés

Merci

 

[skoobi]

Re : Trier et ajouter automatiquement un tableau

Bonjour achkar,

tout d'abord, pourquoi n'as-tu pas poursuivi la discussion d'origine?
Bref, je te propose ce code à la place, test et dis-nous:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim ShDest As Worksheet
Dim trouve As Boolean
If Sh.Name = "Feuil2" Or Sh.Name = "Feuil3" Then
  If Application.WorksheetFunction.CountA(Sh.Range("A" & Target.Row & ":D" & Target.Row)) = 4 _
      And (Target.Column = 1 Or Target.Column = 2 Or Target.Column = 3 Or Target.Column = 4) Then
    Set ShDest = Sheets("Feuil1")
    With ShDest
      Set nom = .Columns("A").Find(Sh.Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
      If nom Is Nothing Then
        i = .Cells(65536, 1).End(xlUp).Row
        Sh.Range("A" & Target.Row & ":D" & Target.Row).Copy .Range("A" & i + 1)
        .Range("B" & i + 1).Value = Sh.Name
      Else
        Do
          firstAddress = nom.Address
          If nom.Offset(, 1).Value = Sh.Name Then
            Sh.Range("A" & Target.Row & ":D" & Target.Row).Copy nom
            nom.Offset(, 1).Value = Sh.Name
            trouve = True
          Else: Set nom = .Columns("A").FindNext(nom)
          End If
        Loop While Not nom Is Nothing And nom.Address <> firstAddress
        If Not trouve Then
          i = .Cells(65536, 1).End(xlUp).Row
          Sh.Range("A" & Target.Row & ":D" & Target.Row).Copy .Range("A" & i + 1)
          .Range("B" & i + 1).Value = Sh.Name
        End If
      End If
      .Range("A1").CurrentRegion.Sort Key1:=.Range("A1:B1"), Order1:=xlAscending, Header:=xlYes, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End With
  End If
End If
End Sub

Bon après-midi.

 

[achkar]

Re : Trier et ajouter automatiquement dans un tableau

Bonjour Skoobi,🙂

Content que tu m'aies répondu. En fait je n'ai pas poursuivi la discussion d'origine car ça fait 4 jours que je n'ai pas eu de nouvelles.
En plus, maintenant j'ai un autre problème (tri automatique des feuilles 2 et 3 + la suppression automatique d'une ligne).

Pour ton code, il marche tres tres bien merci encore.😀😀😀

je ne sais pas si tu as le temps de m'aider pour ce probleme de tri
et la suppression car il ne me reste que ça et je pourrais utiliser le fichier excel.

 

[achkar]

Re : Trier et ajouter automatiquement un tableau

Bonjour,

Est-ce que quelqu'un peut m'aider à résoudre au moins un de ces problèmes, svp?

- Faire un tri automatique dans les feuilles 2 et 3 ( macro ), 😕
- Si on supprime une ligne de la feuille 2 et/ou 3 elle s'efface automatiquement de la feuille 1. 😕

Merci.

 

[skoobi]

Re : Trier et ajouter automatiquement un tableau

Re bonjour,

pour le tri des feuilles 2 et 3 essaie ceci:

Sheets("Feuil2").Range("A1").CurrentRegion.Sort Key1:=Sheets("Feuil2").Range("A1:B1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Sheets("Feuil3").Range("A1").CurrentRegion.Sort Key1:=Sheets("Feuil3").Range("A1:B1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Bon après-midi 🙂

 

[achkar]

Re : Trier et ajouter automatiquement un tableau

Bonjour,

C gentil mais je ne sais pas ou je dois le mettre :

- dans Private Sub Worksheet_SelectionChange(ByVal Target As Range) de lla feuille 2 => il bug

- dans Sud tri() de la feuille 2 => rien qui marche

- dans Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) => je ne sais pas ou je dois le mettre


Merci
@++

 

[skoobi]

Re : Trier et ajouter automatiquement un tableau

Re,

dans Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

à la suite du code actuel.

 

[achkar]

Re : Trier et ajouter automatiquement un tableau

Re bonjour,

je confirme que j'ai mis le code dans : Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) mais il y a rien qui marche . 😕


Personnelement j'ai excel 2000, et je ne sais pas si ce code va marcher avec excel 2003. et s'il faut avoir un changement de code dans ces deux version j'aimerai bien les connaitre .


merci

 

[skoobi]

Re : Trier et ajouter automatiquement un tableau

Re,

ceci devrait marcher (j'ai tester):

With Sh
  .Range("A1").CurrentRegion.Sort Key1:=.Range("A1:B1"), Order1:=xlAscending, Header:=xlYes, _
  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With

bien sur il faut adapter la clé (Key1), le sens de tri (Order1) etc...

 

[achkar]

Re : Trier et ajouter automatiquement dans un tableau

Bonjour,🙂

j'ai déja essayé ce code dans la feuille 2 et 3, il marche mais la boucle ne s'arrete pas.

par contre il y a rien qui marche dans Workbook_SheetChange


Merci @+

 

[skoobi]

Re : Trier et ajouter automatiquement un tableau

Bonjour,

petite erreur dans ton code, voici ce qu'il faut écrire à la fin:

  .........
................
  ' Le code ajouter pour le tri automatique de la feuil 2 et 3
With Sh
  .Range("A1").CurrentRegion.Sort Key1:=.Range("A1:B1"), Order1:=xlAscending, Header:=xlYes, _
  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
'Fin
 
End If
End Sub

 

[skoobi]

Re : Trier et ajouter automatiquement un tableau

Re,

Si on supprime une ligne de la feuille 2 et/ou 3 elle s'efface automatiquement de la feuille 1

Regarde le fichier joint à adapter à ton cas.

 

[achkar]

Re : Trier et ajouter automatiquement dans un tableau

Bonjour Skoobi,

je pense que je ne suis pas claire dans mes details :

j'ai presque réussi à trouver ce que je souhaite.
En fait, ce que je veux c'est que, apres la saisie des cellules "A" à "D"
la ligne se trie automatiquement par ordre alphabétique de la colonne "A" mais avec ton code il fait le tri sur la colonne "A" avant de terminer la saisie de la ligne. Et avec le code que j'ai utilisé,apres la saisie des cellules "A" à "D" le tri se fait, mais sur la colonne "D"
(c'est à dire qu'il trie la ligne par ordre croissant de la colonne D).

voici mon code :

With Sh
.Range("E1").CurrentRegion.Sort Key1:=.Range("E1😀1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With



Et pour la suppression, je n'ai rien compris à ton fichier.
Je pense que je vais laisser tomber car ça fait un bon moment que je cherche sans rien trouver.😱


Merci encore pour toutes tes réponses
@+

 

[skoobi]

Re : Trier et ajouter automatiquement un tableau

Bon,

voici un nouveau jet avec le tri corrigé et la suppression de ligne en plus 😉.

Attention: il faut supprimer une ligne à la fois.

Bonne soirée.

Edit: version 2.2 créé

 

[achkar]

Re : Trier et ajouter automatiquement un tableau

Bonjour SKOOBI,

-Pour la suppression, j'ai qu'une chose a te dire : Bravo tu es fort, c'est excactement ce que je veux . Merci 🙂🙂

- Par contre pour le tri de la feuille 2 et 3, je ne vois pas ou se trouve la correction car il fait toujours le tri à partir de la colonne "D" 😕, et moi je souhaite qu'il fasse le tri par ordre croissant de la colonne "A" !



Merci pour ta patience 😀