XL 2019 copier la valeur automatiquement

KHEROUBI · 28 Avril 2021

Bonjour,
J'ai un cas :
J'ai une feuille "Suivi" qui englobe tous les contrats et chaque contrat à sa propre feuille.
Quand j'ajoute une facture d'un contrat dans sa feuille avec son numéro, sa date et son montant, bon il affiche le reste à facturer, ce reste à facturer je veux qu'il s'affiche automatiquement dans sa ligne dans la feuille "suivi".
Merci

soan · 11 Mai 2021

Bonjour KHEROUBI,

comme tu as été très long à répondre, j'ai bien cru que cet exo ne t'intéressait plus ! même si c'était le cas, c'est quand même mieux que tu reviennes sur ton sujet pour indiquer ton avis à propos de la dernière solution proposée ; sans ça, je me dis que j'ai travaillé sur ton exo pour rien !

avant de faire une nouvelle demande, tu aurais pu dire : « j'ai essayé le fichier joint dans ton post #3 », puis donner ton avis dessus : « c'est ok, ça donne bien les résultats attendus » OU « c'est pas bon, y'a ça qui ne va pas, en précisant bien ce qui cloche ».

perso...

KHEROUBI · 2 Mai 2021

Bonjour ,
voulez vous bien me pencher sur mon cas mes chers internautes.
merci

soan · 3 Mai 2021

Bonjour KHEROUBI,

ton fichier en retour ; sur la 1ère feuille "Suivi", fais Ctrl e ➯ travail effectué !

sub MajRAF() : le nom est l'abréviation de : Mise à jour du Reste À Facturer.

VB:

Sub MajRAF()
  If ActiveSheet.Name <> "Suivi" Then Exit Sub
  Dim ST$, c01 As Range, c02 As Range, k&, n%, i%
  n = Worksheets.Count: Application.ScreenUpdating = 0
  For i = 2 To n
    With Worksheets(i)
      ST = .[A4]
      If ST <> "" Then
        Set c01 = ActiveSheet.Columns(1).Find(ST, , -4163, 1, 1)
        If Not c01 Is Nothing Then
          Set c02 = .Cells(Rows.Count, 8).End(3): k = c02.Row
          If k > 8 Then c01.Offset(, 3) = c02
        End If
      End If
    End With
  Next i
End Sub

à te lire pour avoir ton avis.

soan

KHEROUBI · 9 Mai 2021

Bonjour Soan,
Désolé pour le retard

1/ J'ai changé de la recherche d'un "sous traitant" vers la recherche "N° contrat" vu qu'un sous traitant peut avoir plusieurs contrats.

Sub MajRAF()
If ActiveSheet.Name <> "Suivi" Then Exit Sub
Dim ST$, c01 As Range, c02 As Range, k&, n%, i%
n = Worksheets.Count: Application.ScreenUpdating = 0
For i = 2 To n
With Worksheets(i)
ST = .[A9]
If ST <> "" Then
Set c01 = ActiveSheet.Columns(3).Find(ST, , -4163, 1, 1)
If Not c01 Is Nothing Then
Set c02 = .Cells(Rows.Count, 8).End(3): k = c02.Row
If k > 2 Then c01.Offset(, 1) = c02
End If
End If
End With
Next i
End Sub

2/ J'ai ajouté une colonne dans la feuille "Suivi" pour "Fin de contrat" pour chaque contrat.

je cherche à ce que quand il reste un mois de la fin contrat il m'affiche un message que le contrat est à sa fin.

Merci

soan · 11 Mai 2021

Bonjour KHEROUBI,

comme tu as été très long à répondre, j'ai bien cru que cet exo ne t'intéressait plus ! même si c'était le cas, c'est quand même mieux que tu reviennes sur ton sujet pour indiquer ton avis à propos de la dernière solution proposée ; sans ça, je me dis que j'ai travaillé sur ton exo pour rien !

avant de faire une nouvelle demande, tu aurais pu dire : « j'ai essayé le fichier joint dans ton post #3 », puis donner ton avis dessus : « c'est ok, ça donne bien les résultats attendus » OU « c'est pas bon, y'a ça qui ne va pas, en précisant bien ce qui cloche ».

perso, j'ai testé le code VBA de mon fichier du post #3 et ça retourne bien les résultats attendus ; donc même si tu n'as pas donné ton avis dessus, j'estime que le sujet est résolu pour ce qui concerne ta demande précédente ; mais je ne pouvais pas deviner que tu avais fait un changement important, et que tu allais faire une nouvelle demande !

tu as écrit : « J'ai ajouté une colonne dans la feuille "Suivi" pour "Fin de contrat" pour chaque contrat. »

ok, c'est vu : sur la feuille "Suivi", c'est la colonne E "Fin de Contrat".

tu as écrit : « J'ai changé de la recherche d'un "sous-traitant" vers la recherche "N° contrat" vu qu'un sous-traitant peut avoir plusieurs contrats. »

ok, je comprends très bien, et tu as très bien fait ; mais du coup, pour le code VBA, c'est bien mieux d'adopter une "stratégie" complètement différente de la 1ère, d'où un nouveau code VBA très différent du 1er.

tu as écrit : « je cherche à ce que quand il reste un mois de la fin contrat il m'affiche un message que le contrat est à sa fin. »

ok, c'est fait par une MFC.

sur la 1ère feuille "Suivi", fais Ctrl e ➯ travail effectué ! au vu des résultats, je suppose que tu devines pourquoi j'ai modifié la date de fin de contrat de la "SARL LUCKY", n'est-ce pas ? oui, c'est bien ça, je parle de la feuille "AL 410 20 P", cellule i3 ; au cas où y'aurait besoin d'adapter la MFC, je te laisse le faire.

voici le nouveau code VBA :

VB:

Sub MajRAF()
  If ActiveSheet.Name <> "Suivi" Then Exit Sub
  Dim cel As Range, k&, n&, i%
  With ActiveSheet.ListObjects("Tableau9")
    If .DataBodyRange Is Nothing Then Exit Sub
    n = .ListRows.Count + 2
  End With
  Application.ScreenUpdating = 0
  On Error GoTo 1 'au cas où la feuille n'existe pas
  For i = 3 To n
    With Worksheets(Cells(i, 3).Value)
      Cells(i, 4).Resize(, 2).ClearContents
      Set cel = .Cells(Rows.Count, 8).End(3): k = cel.Row
      Cells(i, 5) = .[I3]: If k > 8 Then Cells(i, 4) = cel
    End With
1 Next i
End Sub

tu vois, il est bien plus simple que le code VBA précédent. note bien qu'il n'y a plus de boucle pour balayer les feuilles du classeur 2 à n ; et y'a plus besoin d'utiliser .Find ; quand j'te parlais d'adopter une toute autre stratégie, c'est exactement de ça qu'il s'agit !

bon, j'espère que cette fois, tu n'oublieras pas d'revenir sur ce sujet pour indiquer ton avis, et même tu pourras marquer ce post comme solution si tout est ok ; je rappelle qu'il suffit de cliquer sur la coche en forme de "V" qui est sur le bord vertical droit du post.

soan

KHEROUBI · 12 Mai 2021

Bonjour Soan
Merci pour ce précieux aide.

XL 2019 copier la valeur automatiquement

KHEROUBI

XLDnaute Junior

Pièces jointes

soan

KHEROUBI

XLDnaute Junior

soan

XLDnaute Barbatruc

Pièces jointes

KHEROUBI

XLDnaute Junior

Pièces jointes

soan

XLDnaute Barbatruc

Pièces jointes

KHEROUBI

XLDnaute Junior

Discussions similaires