Microsoft 365 copier une cellule dans une autre feuille sous condition

mlleh22 · 3 Février 2021

Bonjour, je me permet de vous contacter pour vous demander de l'aide dans le cadre d'un projet.
Je suis à la recherche d'une macro pour copier le numéro de ticket(A3),(A12),(A21), ect, dans les autres onglets.

EXPLICATION:
Par exemple, je souhaiterais que lorsque que je rentre Matthieu dans la ligne "gestionnaire" le tableau 1 soit directement envoyé dans la page consacrée à Matthieu (feuille 2).

Merci beaucoup pour votre aide, si vous avez besoin de plus de renseignements n'hésité pas.
En attente de votre retour

Cordialement

soan · 3 Février 2021

Bonjour mlleh22,

Bienvenue sur le site XLD !

je te propose le fichier Excel joint ci-dessous.

* en B11, saisis "NADEGE" ➯ feuille "2-Nadège", en A2 : 1

* en B20, saisis "MATTHIEU" ➯ feuille "1-Matthieu", en A2 : 2

remarque : il y a écrit : « INFO: nous souhaitons que le numéro du ticket apparaisse dans la colonne A. Le gestionnaire complétera manuellement l'état du ticket. » et « Par exemple le ticket numéro 2 est Matthieu alors copier le numéro du ticket A12 (feuille 1) dans A2 automatiquement. » ; ce que tu as mis pour "EXPLICATION:" ne concorde pas !

si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis.

soan

mlleh22 · 3 Février 2021

soan à dit:
Bonjour mlleh22,

Bienvenue sur le site XLD !

je te propose le fichier Excel joint ci-dessous.

* en B11, saisis "NADEGE" ➯ feuille "2-Nadège", en A2 : 1

* en B20, saisis "MATTHIEU" ➯ feuille "1-Matthieu", en A2 : 2

remarque : il y a écrit : « INFO: nous souhaitons que le numéro du ticket apparaisse dans la colonne A. Le gestionnaire complétera manuellement l'état du ticket. » et « Par exemple le ticket numéro 2 est Matthieu alors copier le numéro du ticket A12 (feuille 1) dans A2 automatiquement. » ; ce que tu as mis pour "EXPLICATION:" ne concorde pas !

si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis.

soan

Bonjour, merci beaucoup pour votre aide, vous nous avez bien aidé!

Pour l'instant il n'y a que 3 tickets or par la suite, il n'y en aura beaucoup plus. Est-ce possible de ne pas écrasé le premier ticket?

Par exemple sur le fichier joint, nous avons attribué l'essemble des tickets à Matthieu, nous constatons que dans son onglet, seul le dernier ticket attribué est mentionné dans la cellule A2. Nous souhaitons qu'à chaque nouveau ticket, qu'il soit noté en dessous (par exemple A4,A5,A6...)

Et j'ai également relevé un autre problème, lorsque je note par exemple Lætitia, pour le ticket 3, or je voulait mettre Franck, le numéro du ticket reste dans la feuille de Lætitia, or il ne faudrait pas que cela y reste. Est-ce possible de faire quelque chose pour changer cela?

Encore merci
Cordialement

soan · 3 Février 2021

@mlleh22

ton fichier en retour.

* en B20, saisis "MATTHIEU" ➯ feuille "1-Matthieu", en A2 : 2

* en B38, saisis "MATTHIEU" ➯ feuille "1-Matthieu", en A3 : 4

* en B47, saisis "MATTHIEU" ➯ feuille "1-Matthieu", en A4 : 5

ainsi, ça n'écrase plus le 1er ticket mais ça les met les en dessous ; code VBA :

VB:

Option Explicit

Private Function SansAccents(chn$) As String
  Dim c01$, c02$, p%
  For p = 1 To Len(chn)
    c01 = Mid$(chn, p, 1): c02 = "@"
    Select Case c01
      Case "á", "à", "â", "ä", "ã", "å": c02 = "a"
      Case "é", "è", "ê", "ë": c02 = "e"
      Case "í", "ì", "î", "ï": c02 = "i"
      Case "ó", "ò", "ô", "ö", "õ", "ø": c02 = "o"
      Case "ú", "ù", "û", "ü": c02 = "u"
      Case "ñ": c02 = "n"
      Case "ç": c02 = "c"
      Case "š": c02 = "s"
      Case "ý", "ÿ": c02 = "y"
      Case "ž": c02 = "z"
    End Select
    If c02 <> "@" Then Mid$(chn, p, 1) = c02
  Next p
  SansAccents = chn
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim lig&, gst$, chn$, i%
  With Target
    If .CountLarge > 1 Then Exit Sub
    If .Column <> 2 Then Exit Sub
    lig = .Row: If lig < 11 Then Exit Sub
    If (lig - 3) Mod 9 <> 8 Then Exit Sub
    gst = .Value: If gst = "" Then Exit Sub
    For i = 2 To Worksheets.Count
      chn = Worksheets(i).Name
      chn = Right$(chn, Len(chn) - 2)
      If chn <> "" Then
        chn = SansAccents(LCase$(chn))
        If chn = LCase$(gst) Then
          With Worksheets(i)
            lig = .Cells(Rows.Count, 1).End(3).Row + 1
            .Cells(lig, 1) = Target.Offset(-8, -1)
          End With
        End If
      End If
    Next i
  End With
End Sub

je n'ai rien fait pour ta 2ème demande concernant une correction comme Franck au lieu de Lætitia car ça devient compliqué et je crois que « le jeu n'en vaut pas la chandelle » ; regarde les futures réponses, au cas où un autre intervenant veux essayer et peut te trouver une solution.

soan

mlleh22 · 4 Février 2021

soan à dit:
@mlleh22

ton fichier en retour.

* en B20, saisis "MATTHIEU" ➯ feuille "1-Matthieu", en A2 : 2

* en B38, saisis "MATTHIEU" ➯ feuille "1-Matthieu", en A3 : 4

* en B47, saisis "MATTHIEU" ➯ feuille "1-Matthieu", en A4 : 5

ainsi, ça n'écrase plus le 1er ticket mais ça les met les en dessous ; code VBA :

VB:

Option Explicit Private Function SansAccents(chn$) As String Dim c01$, c02$, p% For p = 1 To Len(chn) c01 = Mid$(chn, p, 1): c02 = "@" Select Case c01 Case "á", "à", "â", "ä", "ã", "å": c02 = "a" Case "é", "è", "ê", "ë": c02 = "e" Case "í", "ì", "î", "ï": c02 = "i" Case "ó", "ò", "ô", "ö", "õ", "ø": c02 = "o" Case "ú", "ù", "û", "ü": c02 = "u" Case "ñ": c02 = "n" Case "ç": c02 = "c" Case "š": c02 = "s" Case "ý", "ÿ": c02 = "y" Case "ž": c02 = "z" End Select If c02 <> "@" Then Mid$(chn, p, 1) = c02 Next p SansAccents = chn End Function Private Sub Worksheet_Change(ByVal Target As Range) Dim lig&, gst$, chn$, i% With Target If .CountLarge > 1 Then Exit Sub If .Column <> 2 Then Exit Sub lig = .Row: If lig < 11 Then Exit Sub If (lig - 3) Mod 9 <> 8 Then Exit Sub gst = .Value: If gst = "" Then Exit Sub For i = 2 To Worksheets.Count chn = Worksheets(i).Name chn = Right$(chn, Len(chn) - 2) If chn <> "" Then chn = SansAccents(LCase$(chn)) If chn = LCase$(gst) Then With Worksheets(i) lig = .Cells(Rows.Count, 1).End(3).Row + 1 .Cells(lig, 1) = Target.Offset(-8, -1) End With End If End If Next i End With End Sub

je n'ai rien fait pour ta 2ème demande concernant une correction comme Franck au lieu de Lætitia car ça devient compliqué et je crois que « le jeu n'en vaut pas la chandelle » ; regarde les futures réponses, au cas où un autre intervenant veux essayer et peut te trouver une solution.

soan

Je vous remercie énormément, merci merci beaucoup
Tout fonctionne )

soan · 7 Février 2021

Bonjour mlleh22,

J'ai trouvé une solution pour la suppression et le changement d'un gestionnaire.

* sur la feuille "1-Matthieu", tu peux voir que A2 est vide.
* va sur la feuille "2-Nadège" ; A2 est vide aussi.
* va sur la feuille "Générale" ; en B11, saisis "NADEGE" et valide.
* vérifie que sur "2-Nadège", il y a 1 en A2.

* va sur "Générale" ; tu es en B11 ; appuie sur la touche Suppression.
* va sur "2-Nadège" ; tu peux voir que le 1 de A2 a été supprimé.

* va sur "Générale" ; en B11, saisis "MATTHIEU" et valide.

* va sur "1-Matthieu" ; il y a 1 en A2 ; normal ... sauf que t'as fait une erreur de saisie : tu aurais dû mettre "NADEGE" et pas "MATTHIEU" ! ne change rien, et retourne sur la 1ère feuille.
* sur "Générale", en B11, sans avoir besoin de supprimer "MATTHIEU", saisis à la place "NADEGE" et valide.
* va sur "1-Matthieu" ; tu peux voir que le 1 de A2 a été supprimé ; va sur "2-Nadège" ; tu peux voir qu'il y a 1 en A2 ➯ la correction a bien été effectuée.

ce que j'écris maintenant est par rapport au dernier paragraphe de ton post #3 : tu pourras faire de même pour ton ticket 3, si tu as saisi Lætitia alors que tu aurais voulu saisir Franck : il suffit donc de saisir "Franck" à la place de "Lætitia", sans devoir supprimer d'abord "Lætitia".

je te laisse faire d'autres tests.

si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis.

VB:

Option Explicit

Private Function SansAccents(chn$) As String
  Dim c01$, c02$, p%
  For p = 1 To Len(chn)
    c01 = Mid$(chn, p, 1): c02 = "@"
    Select Case c01
      Case "á", "à", "â", "ä", "ã", "å": c02 = "a"
      Case "é", "è", "ê", "ë": c02 = "e"
      Case "í", "ì", "î", "ï": c02 = "i"
      Case "ó", "ò", "ô", "ö", "õ", "ø": c02 = "o"
      Case "ú", "ù", "û", "ü": c02 = "u"
      Case "ñ": c02 = "n"
      Case "ç": c02 = "c"
      Case "š": c02 = "s"
      Case "ý", "ÿ": c02 = "y"
      Case "ž": c02 = "z"
    End Select
    If c02 <> "@" Then Mid$(chn, p, 1) = c02
  Next p
  SansAccents = chn
End Function

Private Sub IndexFX(gst$, idx%)
  Dim chn$, i%: idx = 0
  For i = 2 To Worksheets.Count
    chn = Worksheets(i).Name
    chn = Right$(chn, Len(chn) - 2)
    If chn <> "" Then
      chn = SansAccents(LCase$(chn))
      If chn = LCase$(gst) Then idx = i: Exit For
    End If
  Next i
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim tck As Range, cel As Range, gst1$, gst2$, idx%, lig&
  With Target
    If .CountLarge > 1 Then Exit Sub
    If .Column <> 2 Then Exit Sub
    lig = .Row: If lig < 11 Then Exit Sub
    If (lig - 3) Mod 9 <> 8 Then Exit Sub
    Set tck = .Offset(-8, -1): gst2 = .Value
  End With
  With Application
    .ScreenUpdating = 0: .EnableEvents = 0: .Undo
    gst1 = Target: Target = gst2: .EnableEvents = -1
  End With
  If gst1 <> "" And (gst2 = "" Or gst2 <> gst1) Then
    IndexFX gst1, idx
    If idx > 0 Then
      With Worksheets(idx)
        Set cel = .Columns(1).Find(tck, , -4163, 1, 1)
        If Not cel Is Nothing Then .Rows(cel.Row).Delete
      End With
    End If
  End If
  If gst2 = "" Then Exit Sub
  IndexFX gst2, idx: If idx = 0 Then Exit Sub
  With Worksheets(idx)
    lig = .Cells(Rows.Count, 1).End(3).Row + 1
    .Cells(lig, 1) = tck
  End With
End Sub

soan

Microsoft 365 copier une cellule dans une autre feuille sous condition

mlleh22

XLDnaute Nouveau

soan

XLDnaute Barbatruc

Pièces jointes

mlleh22

XLDnaute Nouveau

Pièces jointes

soan

XLDnaute Barbatruc

Pièces jointes

mlleh22

XLDnaute Nouveau

soan

XLDnaute Barbatruc

Pièces jointes

Discussions similaires