1. Ce site utilise des "témoins de connexion" (cookies) conformes aux textes de l'Union Européenne. Continuer à naviguer sur nos pages vaut acceptation de notre règlement en la matière. En savoir plus.

Macro pour modifier automatiquement des éléments sur deux feuilles différentes

Discussion dans 'Forum Excel' démarrée par Nicolas Lepauvre, 14 Septembre 2017.

  1. Nicolas Lepauvre

    Nicolas Lepauvre XLDnaute Junior

    Inscrit depuis le :
    4 Septembre 2017
    Messages :
    53
    "J'aime" reçus :
    0
    Bonjour à tous !
    Je souhaite faire la chose suivante.
    Si on effectue une modification dans l’une des colonnes B, C, D ou E de la feuille1, elle s‘actualise automatiquement sur la feuille2.
    De même si on effectue une modification dans l’une des colonnes E ou D de la feuille2, elle devrait s‘actualiser automatiquement sur la feuille1. En plus si on fait une nouvelle inscription sur la feuille2 elle devrait apparaître sur la feuille1.
    J’ai écrit un code dans un module mais il ne se passe rien.
    De ce fait je sollicite vos aides précieuses.
    Je vous remercie d’avance.
     

    Pièces jointes:

  2. Nicolas Lepauvre

    Nicolas Lepauvre XLDnaute Junior

    Inscrit depuis le :
    4 Septembre 2017
    Messages :
    53
    "J'aime" reçus :
    0
    Aidez moi s'il vous plait.
     
  3. vgendron

    vgendron XLDnaute Barbatruc

    Inscrit depuis le :
    24 Février 2009
    Messages :
    4050
    "J'aime" reçus :
    293
    Utilise:
    Excel 2007 (PC)
    Hello
    voir PJ avec macro dans les évènements change des deux feuilles.
     

    Pièces jointes:

    zebanx aime votre message.
  4. job75

    job75 XLDnaute Barbatruc

    Inscrit depuis le :
    15 Mai 2008
    Messages :
    23370
    "J'aime" reçus :
    1745
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2013 (PC)
    Bonjour Nicolas Lepauvre, vgendron, le forum,

    Avec des tris c'est très rapide, voyez le fichier joint et ces macros :
    Code (Text):
    Sub feuille1_vers_feuille2()
    Dim P1 As Range, P2 As Range, rc&
    Set P1 = Tabelle1.[A1].CurrentRegion
    Set P2 = Tabelle2.[A1].CurrentRegion
    If P2.Parent.FilterMode Then P2.Parent.ShowAllData 'si la feuille est filtrée
    rc = P1.Rows.Count
    If rc > 1 Then P2.Rows(2).Resize(rc - 1).Insert xlDown 'insertion de lignes
    P2(1).Resize(rc) = P1.Columns(1).Value
    P2(1, 3).Resize(rc) = P1.Columns(4).Value
    P2(1, 2).Resize(rc) = P1.Columns(5).Value
    P2.Sort P2(1), xlAscending, Header:=xlYes '1er tri sur colonne A
    With P2.Offset(1).Columns(5)
      .Formula = "=1/(A1<>A2)"
      .Value = .Value 'supprime les formules
      .EntireRow.Resize(, 5).Sort .Cells, xlAscending, Header:=xlNo '2ème tri pour accélérer
      On Error Resume Next 'si aucune valeur d'erreur
      .SpecialCells(xlCellTypeConstants, 16).EntireRow.Resize(, 5).Delete xlUp
      .ClearContents
      With .Parent.UsedRange: End With 'actualise les barres de défilement
    End With
    P2.Parent.Activate 'facultatif
    End Sub

    Sub feuille2_vers_feuille1()
    Dim P1 As Range, P2 As Range, rc&
    Set P1 = Tabelle1.[A1].CurrentRegion
    Set P2 = Tabelle2.[A1].CurrentRegion
    If P1.Parent.FilterMode Then P1.Parent.ShowAllData 'si la feuille est filtrée
    rc = P2.Rows.Count
    If rc > 1 Then P1.Rows(2).Resize(rc - 1).Insert xlDown 'insertion de lignes
    P1(1).Resize(rc) = P2.Columns(1).Value
    P1(1, 5).Resize(rc) = P2.Columns(2).Value
    P1(1, 4).Resize(rc) = P2.Columns(3).Value
    P1.Sort P1(1), xlAscending, Header:=xlYes '1er tri sur colonne A
    P1.Resize(, 3).Sort P1(1), xlAscending, P1(1, 2), , , P1(1, 3), Header:=xlYes '2ème tri sur 3 colonnes
    With P1.Offset(1).Columns(7)
      .Formula = "=1/(A1<>A2)"
      .Value = .Value 'supprime les formules
      .EntireRow.Resize(, 7).Sort .Cells, xlAscending, Header:=xlNo '3ème tri pour accélérer
      On Error Resume Next 'si aucune valeur d'erreur
      .SpecialCells(xlCellTypeConstants, 16).EntireRow.Resize(, 7).Delete xlUp
      .ClearContents
      With .Parent.UsedRange: End With 'actualise les barres de défilement
    End With
    P1.Parent.Activate 'facultatif
    End Sub
    Il ne faut pas de doublons en colonne A : j'y ai ajouté une validation des données.

    Voyez aussi les MFC pour les bordures et la couleur des titres.

    Edit : ajouté le code pour le cas où la feuille de destination est filtrée.

    A+
     

    Pièces jointes:

    Dernière édition: 18 Septembre 2017
  5. job75

    job75 XLDnaute Barbatruc

    Inscrit depuis le :
    15 Mai 2008
    Messages :
    23370
    "J'aime" reçus :
    1745
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2013 (PC)
    Re,

    Si l'on veut pouvoir utiliser des tableaux Excel c'est plus sportif, voyez ce fichier (2).

    Bonne nuit.
     

    Pièces jointes:

  6. Nicolas Lepauvre

    Nicolas Lepauvre XLDnaute Junior

    Inscrit depuis le :
    4 Septembre 2017
    Messages :
    53
    "J'aime" reçus :
    0
  7. job75

    job75 XLDnaute Barbatruc

    Inscrit depuis le :
    15 Mai 2008
    Messages :
    23370
    "J'aime" reçus :
    1745
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2013 (PC)
    Re,

    Je préfère cette solution avec le Dictionary car la conception est plus simple (pas de colonne auxiliaire) :
    Code (Text):
    Sub feuille1_vers_feuille2()
    Dim t, P As Range, rest(), d As Object, i&, a, b, s
    t = Tabelle1.[A1].CurrentRegion.Resize(, 5) 'matrice, plus rapide
    Set P = Tabelle2.[A1].CurrentRegion.Resize(, 3)
    ReDim rest(UBound(t) + P.Rows.Count - 2, 2) 'base 0
    Set d = CreateObject("Scripting.Dictionary")
    d.CompareMode = vbTextCompare 'la casse est ignorée
    For i = 2 To UBound(t)
      d(t(i, 1)) = t(i, 5) & Chr(1) & t(i, 4)
    Next
    t = P 'matrice, plus rapide
    For i = 2 To UBound(t)
      If Not d.exists(t(i, 1)) Then d(t(i, 1)) = t(i, 2) & Chr(1) & t(i, 3)
    Next
    If d.Count Then
      a = d.keys: b = d.items
      For i = 0 To UBound(a)
        rest(i, 0) = a(i)
        s = Split(b(i), Chr(1))
        rest(i, 1) = s(0): rest(i, 2) = s(1)
      Next
      '---restitition---
      If P.Parent.FilterMode Then P.Parent.ShowAllData 'si la feuille est filtrée
      If P.SpecialCells(xlCellTypeVisible).Count < P.Count Then _
        P.AutoFilter: P.AutoFilter 'défiltrage si tableau Excel
      P(2, 1).Resize(d.Count, 3) = rest
    End If
    P.CurrentRegion.Sort P(1), xlAscending, Header:=xlYes 'tri facultatif
    P.Parent.Activate 'facultatif
    End Sub

    Sub feuille2_vers_feuille1()
    Dim P As Range, t, d As Object, i&, s, a, b, rest()
    Set P = Tabelle1.[A1].CurrentRegion.Resize(, 5)
    t = P 'matrice, plus rapide
    Set d = CreateObject("Scripting.Dictionary")
    d.CompareMode = vbTextCompare 'la casse est ignorée
    For i = 2 To UBound(t)
      d(t(i, 1)) = t(i, 2) & Chr(1) & t(i, 3) & Chr(1) & t(i, 4) & Chr(1) & t(i, 5)
    Next
    t = Tabelle2.[A1].CurrentRegion.Resize(, 3) 'matrice, plus rapide
    For i = 2 To UBound(t)
      If d.exists(t(i, 1)) Then
        s = Split(d(t(i, 1)), Chr(1))
        s(2) = t(i, 3): s(3) = t(i, 2) 'remplacement
        d(t(i, 1)) = Join(s, Chr(1))
      Else
        d(t(i, 1)) = Chr(1) & Chr(1) & t(i, 3) & Chr(1) & t(i, 2)
      End If
    Next
    If d.Count Then
      a = d.keys: b = d.items
      ReDim rest(P.Rows.Count + UBound(t) - 2, 4) 'base 0
      For i = 0 To UBound(a)
        rest(i, 0) = a(i)
        s = Split(b(i), Chr(1))
        rest(i, 1) = s(0): rest(i, 2) = s(1): rest(i, 3) = s(2): rest(i, 4) = s(3)
      Next
      '---restitition---
      If P.Parent.FilterMode Then P.Parent.ShowAllData 'si la feuille est filtrée
      If P.SpecialCells(xlCellTypeVisible).Count < P.Count Then _
        P.AutoFilter: P.AutoFilter 'défiltrage si tableau Excel
      P(2, 1).Resize(d.Count, 5) = rest
    End If
    P.CurrentRegion.Sort P(1), xlAscending, Header:=xlYes 'tri facultatif
    P.Parent.Activate 'facultatif
    End Sub
    Ces macros ne sont pas plus rapides que les précédentes : sur des tableaux de 100 000 lignes (sans doublons en colonne A) toutes les durées d'exécution sont chez moi entre 5 et 8 secondes.

    Fichier (3).

    A+
     

    Pièces jointes:

  8. Nicolas Lepauvre

    Nicolas Lepauvre XLDnaute Junior

    Inscrit depuis le :
    4 Septembre 2017
    Messages :
    53
    "J'aime" reçus :
    0
    Bonjour vgendron, bonjour le forum
    J’ai encore un Problème.
    Les nouvelles inscriptions faites sur la feuille 1 ne s’actualisent pas automatiquement sur la feuille 2. Et vice versa.
    Pouvez-vous une fois de plus m’aider ?
    Merci.
     

    Pièces jointes:

  9. job75

    job75 XLDnaute Barbatruc

    Inscrit depuis le :
    15 Mai 2008
    Messages :
    23370
    "J'aime" reçus :
    1745
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2013 (PC)
    Bonjour Nicolas, vgendron,

    La solution de vgendron a un autre inconvénient : effacez ensemble tous les âges en Feuille1...

    A+
     
  10. job75

    job75 XLDnaute Barbatruc

    Inscrit depuis le :
    15 Mai 2008
    Messages :
    23370
    "J'aime" reçus :
    1745
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2013 (PC)
    Re,

    Si pour tout automatiser vous voulez supprimer les boutons utilisez des Worksheet_Activate, fichier (4).

    A+
     

    Pièces jointes:

  11. Nicolas Lepauvre

    Nicolas Lepauvre XLDnaute Junior

    Inscrit depuis le :
    4 Septembre 2017
    Messages :
    53
    "J'aime" reçus :
    0
    Bonjour Job75 et merci.
    Le problème avec votre code est qu'il y a autant d'inscription sur la feuille 1 que sur la feuille 2. Et cela ne doit pas être le cas. Le feuille 1 doit avoir plus d'inscriptions que la feuille 2. Et les éléments ne doivent pas être sur la même ligne.
    Merci.
     
  12. job75

    job75 XLDnaute Barbatruc

    Inscrit depuis le :
    15 Mai 2008
    Messages :
    23370
    "J'aime" reçus :
    1745
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2013 (PC)
    Bonjour Nicolas,
    Pourtant quand vous dites :
    je comprends qu'il y a les mêmes inscriptions.

    A+
     
  13. Nicolas Lepauvre

    Nicolas Lepauvre XLDnaute Junior

    Inscrit depuis le :
    4 Septembre 2017
    Messages :
    53
    "J'aime" reçus :
    0
    Non!
     
  14. Nicolas Lepauvre

    Nicolas Lepauvre XLDnaute Junior

    Inscrit depuis le :
    4 Septembre 2017
    Messages :
    53
    "J'aime" reçus :
    0
    Les inscriptions sont les mêmes. Mais la quantité est différente sur les feuilles.
     
  15. Nicolas Lepauvre

    Nicolas Lepauvre XLDnaute Junior

    Inscrit depuis le :
    4 Septembre 2017
    Messages :
    53
    "J'aime" reçus :
    0
    Bonjour Job75, bonjour le forum
    Encore plus de lumière sur mon problème.
    Les inscriptions faites sur les feuilles 1 et 2 sont dites de « départ » avec x inscriptions sur la feuille 1 et y inscriptions sur la feuille 2. x étant supérieur à y. Dans ce cas on 30 inscriptions (x) sur la feuille 1 et 19 inscriptions (y) sur la feuille 2. Les entêtes n’étant pas comptées.
    Les inscriptions de départ de la feuille 1 qui ne figurent pas sur la feuille 2 ne doivent pas s’y trouver.
    Mais en revanche toute modification et nouvelle inscription faites sur la feuille 1 doivent s’actualiser automatiquement sur la feuille 2.
    Et toute modification et nouvelle inscription faites sur la feuille 2 doivent s’actualiser automatiquement sur la feuille 1.
    Je vous remercie pour votre attention et pour toute éventuelle aide.
     

    Pièces jointes:

  16. Nicolas Lepauvre

    Nicolas Lepauvre XLDnaute Junior

    Inscrit depuis le :
    4 Septembre 2017
    Messages :
    53
    "J'aime" reçus :
    0
    Bonjour vgendron, bonjour le Forum,
    Encore plus de lumière sur mon problème.
    Les inscriptions faites sur les feuilles 1 et 2 sont dites de « départ » avec x inscriptions sur la feuille 1 et y inscriptions sur la feuille 2. x étant supérieur à y. Dans ce cas on 30 inscriptions (x) sur la feuille 1 et 19 inscriptions (y) sur la feuille 2. Les entêtes n’étant pas comptées.
    Les inscriptions de départ de la feuille 1 qui ne figurent pas sur la feuille 2 ne doivent pas s’y trouver.
    Mais en revanche toute modification et nouvelle inscription faites sur la feuille 1 doivent s’actualiser automatiquement sur la feuille 2.
    Et toute modification et nouvelle inscription faites sur la feuille 2 doivent s’actualiser automatiquement sur la feuille 1.
    Je vous remercie pour votre attention et pour toute éventuelle Aide.
     

    Pièces jointes:

  17. Nicolas Lepauvre

    Nicolas Lepauvre XLDnaute Junior

    Inscrit depuis le :
    4 Septembre 2017
    Messages :
    53
    "J'aime" reçus :
    0
    S'il vous plait aidez moi, je suis à bout de souf...!
     
  18. job75

    job75 XLDnaute Barbatruc

    Inscrit depuis le :
    15 Mai 2008
    Messages :
    23370
    "J'aime" reçus :
    1745
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2013 (PC)
    Bonjour Nicolas, le forum,

    Pour cette nouvelle demande il faut repérer les lignes de la liste initiale en Feuille1 (j'ai mis des numéros).

    Ainsi elles ne seront pas considérées comme de nouvelles inscriptions.

    Voici le code, en fait seule la 1ère macro a dû être modifiée :
    Code (Text):
    Sub feuille1_vers_feuille2()
    Dim P As Range, t, d As Object, i&, a, b, rest(), s
    Set P = Tabelle2.[A1].CurrentRegion.Resize(, 3)
    t = P 'matrice, plus rapide
    Set d = CreateObject("Scripting.Dictionary")
    d.CompareMode = vbTextCompare 'la casse est ignorée
    For i = 2 To UBound(t)
      d(t(i, 1)) = t(i, 2) & Chr(1) & t(i, 3)
    Next
    t = Tabelle1.[A1].CurrentRegion.Resize(, 6) 'matrice, plus rapide
    For i = 2 To UBound(t)
      If d.exists(t(i, 1)) And t(i, 6) <> "" Or t(i, 6) = "" Then d(t(i, 1)) = t(i, 5) & Chr(1) & t(i, 4)
    Next
    If d.Count Then
      a = d.keys: b = d.items
      ReDim rest(UBound(a), 2) 'base 0
      For i = 0 To UBound(a)
        rest(i, 0) = a(i)
        s = Split(b(i), Chr(1))
        rest(i, 1) = s(0): rest(i, 2) = s(1)
      Next
      '---restitution---
      If P.Parent.FilterMode Then P.Parent.ShowAllData 'si la feuille est filtrée
      If P.SpecialCells(xlCellTypeVisible).Count < P.Count Then _
        P.AutoFilter: P.AutoFilter 'défiltrage si tableau Excel
      P(2, 1).Resize(d.Count, 3) = rest
    End If
    P.Parent.Activate 'facultatif
    End Sub

    Sub feuille2_vers_feuille1()
    Dim P As Range, t, d As Object, i&, s, a, b, rest()
    Set P = Tabelle1.[A1].CurrentRegion.Resize(, 5)
    t = P 'matrice, plus rapide
    Set d = CreateObject("Scripting.Dictionary")
    d.CompareMode = vbTextCompare 'la casse est ignorée
    For i = 2 To UBound(t)
      d(t(i, 1)) = t(i, 2) & Chr(1) & t(i, 3) & Chr(1) & t(i, 4) & Chr(1) & t(i, 5)
    Next
    t = Tabelle2.[A1].CurrentRegion.Resize(, 3) 'matrice, plus rapide
    For i = 2 To UBound(t)
      If d.exists(t(i, 1)) Then
        s = Split(d(t(i, 1)), Chr(1))
        s(2) = t(i, 3): s(3) = t(i, 2) 'remplacement
        d(t(i, 1)) = Join(s, Chr(1))
      Else
        d(t(i, 1)) = Chr(1) & Chr(1) & t(i, 3) & Chr(1) & t(i, 2)
      End If
    Next
    If d.Count Then
      a = d.keys: b = d.items
      ReDim rest(UBound(a), 4) 'base 0
      For i = 0 To UBound(a)
        rest(i, 0) = a(i)
        s = Split(b(i), Chr(1))
        rest(i, 1) = s(0): rest(i, 2) = s(1): rest(i, 3) = s(2): rest(i, 4) = s(3)
      Next
      '---restitution---
      If P.Parent.FilterMode Then P.Parent.ShowAllData 'si la feuille est filtrée
      If P.SpecialCells(xlCellTypeVisible).Count < P.Count Then _
        P.AutoFilter: P.AutoFilter 'défiltrage si tableau Excel
      P(2, 1).Resize(d.Count, 5) = rest
    End If
    P.Parent.Activate 'facultatif
    End Sub
    Je ne fais plus de tris, ce n'était de toute façon pas indispensable.

    Fichier (5).

    A+
     

    Pièces jointes:

    Dernière édition: 26 Septembre 2017
    zebanx aime votre message.
  19. job75

    job75 XLDnaute Barbatruc

    Inscrit depuis le :
    15 Mai 2008
    Messages :
    23370
    "J'aime" reçus :
    1745
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2013 (PC)
    Bonjour Nicolas,
    J'espère que ça va mieux et que vous avez retrouvé votre souf... ;)

    Vous me paraissez être un curieux personnage : vous criez famine et quand on vous donne à manger, couic, inconnu au bataillon, silence radio.

    A+
     
  20. Nicolas Lepauvre

    Nicolas Lepauvre XLDnaute Junior

    Inscrit depuis le :
    4 Septembre 2017
    Messages :
    53
    "J'aime" reçus :
    0
    Bonjour Job75, bonjour le forum.
    En plus de mes soucis avec Excel s'y sont ajoutés des problèmes de santé. Avec la santé ça va mieux. Mais avec Excel pas.
    Votre pemière reponse peut être facile à comprendre. Le fichier que vous m'avez posté est en attaché. Comment est il possible d'avoir le code de votre fichier sans le tri?
    Merci
     

    Pièces jointes:

Partager cette page