Remplacer valeur cellules suite insertion ligne [Résolu]

fenec

XLDnaute Impliqué
Bonjour le forum,

J’ai à nouveau besoin de votre aide car je ne parviens pas à compléter mon code (merci à Job75) pour changer le contenue de plusieurs cellules suite à l’insertion de lignes.

Dans l’onglet "Etat de congés" je voudrais que le solde réel des congés "M12" et des rtt "M17" se copie dans l’onglet "accueil" dans la ligne insérée et que le pris prév se mette à zéro vu que c’est une nouvelle année.

J’espère être compréhensible

Ci-joint un fichier exemple avec ce que j’aimerais réaliser.

Cordialement

Philippe
 

Pièces jointes

  • exemple.xls
    546.5 KB · Affichages: 56
  • exemple.xls
    546.5 KB · Affichages: 39
  • exemple.xls
    546.5 KB · Affichages: 40
Dernière édition:

job75

XLDnaute Barbatruc
Re : Remplacer valeur cellules suite insertion ligne

Bonsoir fenec,

Par exemple :

Code:
Sub Mise_à_Jour3()
Dim feuille, code, f, c, cel As Range
feuille = Array(Feuil1, Feuil2) 'CodeNames des feuilles à traiter
code = Array("D712", "D727") 'codes à traiter
Application.ScreenUpdating = False
For Each f In feuille
  For Each c In code
    Set cel = f.[B:B].Find(c, , xlValues, xlWhole, , xlPrevious)
    If Not cel Is Nothing Then
      cel(2).EntireRow.Insert 'ligne entière
      cel.Resize(, 12).Copy cel(2)
      cel.Resize(, 12) = cel.Resize(, 12).Value 'supprime les formules
      If IsDate(cel(2, 4)) Then cel(2, 4) = DateAdd("yyyy", 1, cel(2, 4))
      cel(2, 5) = IIf(IsDate(cel(2, 5)), DateAdd("yyyy", 1, cel(2, 5)), 0)
    End If
  Next
Next
End Sub
A+
 

fenec

XLDnaute Impliqué
Re : Remplacer valeur cellules suite insertion ligne

Bonjour le forum, Job75

Déjà merci pour votre aide

Venant de tester votre proposition, je reviens vers vous car seule la remise à zéro s’effectue, le report des soldes des congés "M12" et des RTT "M17" ne se copie pas dans la ligne insérée de l’onglet "accueil".

Ci-joint fichier exemple avec votre code.

Cordialement

Philippe
 

Pièces jointes

  • exemple 2.xls
    546 KB · Affichages: 29
  • exemple 2.xls
    546 KB · Affichages: 36
  • exemple 2.xls
    546 KB · Affichages: 36

job75

XLDnaute Barbatruc
Re : Remplacer valeur cellules suite insertion ligne

Bonjour fenec,

Il faut traiter Feuil2 avant Feuil1 :

Code:
Sub Mise_à_Jour2()
Dim a, code, n As Byte, c, cel As Range
a = Array(Feuil2, Feuil1) 'CodeNames des feuilles à traiter
code = Array("D712", "D727") 'codes à traiter
Application.ScreenUpdating = False
For n = 0 To UBound(a)
  For Each c In code
    Set cel = a(n).[B:B].Find(c, , xlValues, xlWhole, , xlPrevious)
    If Not cel Is Nothing Then
      cel(2).EntireRow.Insert 'ligne entière
      cel.Resize(, 12).Copy cel(2)
      cel.Resize(, 12) = cel.Resize(, 12).Value 'supprime les formules
      cel(2, 4) = IIf(n, a(0).Cells(cel(2).Row, "M"), DateAdd("yyyy", 1, cel(2, 4)))
      cel(2, 5) = IIf(n, 0, DateAdd("yyyy", 1, cel(2, 5)))
    End If
  Next
Next
End Sub
Il est important que dans les 2 feuilles les tableaux soient sur les mêmes lignes.

A+
 

fenec

XLDnaute Impliqué
Re : Remplacer valeur cellules suite insertion ligne

Re le forum, Job75

Apparemment votre code fonctionne mais :

La remise à zéro ok
La mise à jour des dates ok

La copie du solde non ok :
1 : Il copie le solde de la ligne insérée et non celui de l’année précédente
2 :J’obtiens un décalage dans mes formules !!!

Est-ce dû à votre code ou à mes formules ? (je regarde ce point)
Ou que dans votre commentaire quelque chose m’échappe ?

Il est important que dans les 2 feuilles les tableaux soient sur les mêmes lignes.

Ci-joint fichier exemple avec votre code et commentaires de ce que j’ai remarqué après avoir enlever provisoirement dans le code la suppression des formules.

Cordialement

Philippe
 

Pièces jointes

  • exemple 2.xls
    546 KB · Affichages: 42
  • exemple 2.xls
    546 KB · Affichages: 37
  • exemple 2.xls
    546 KB · Affichages: 35

job75

XLDnaute Barbatruc
Re : Remplacer valeur cellules suite insertion ligne

Re,

Et bien copiez la ligne de l'autre feuille que vous voulez, le code n'est pas difficile à modifier.

Edit : si l'on veut la ligne précédente :

Code:
cel(2, 4) = IIf(n, a(0).Cells(cel(2).Row - 1, "M"), DateAdd("yyyy", 1, cel(2, 4)))
A+
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : Remplacer valeur cellules suite insertion ligne

Re,

Ah mais en effet je me suis planté, vous avez tout à fait raison.

Comme les 2 tableaux ont des colonnes B identiques, il faut les traiter en parallèle.

Donc inverser l'ordre des boucles :

Code:
Sub Mise_à_Jour2()
Dim a, code, n As Byte, c, cel As Range
a = Array(Feuil2, Feuil1) 'CodeNames des feuilles à traiter
code = Array("D712", "D727") 'codes à traiter
Application.ScreenUpdating = False
For Each c In code
  For n = 0 To UBound(a)
    Set cel = a(n).[B:B].Find(c, , xlValues, xlWhole, , xlPrevious)
    If Not cel Is Nothing Then
      cel(2).EntireRow.Insert 'ligne entière
      cel.Resize(, 12).Copy cel(2)
      cel.Resize(, 12) = cel.Resize(, 12).Value 'supprime les formules
      cel(2, 4) = IIf(n, a(0).Cells(cel(2).Row - 1, "M"), DateAdd("yyyy", 1, cel(2, 4)))
      cel(2, 5) = IIf(n, 0, DateAdd("yyyy", 1, cel(2, 5)))
    End If
  Next
Next
End Sub
A+
 

fenec

XLDnaute Impliqué
Re : Remplacer valeur cellules suite insertion ligne

Re le forum, Job75

Voulant tester ta dernière solution (en regardant le foot, pas malin), j’ai fait une connerie de débutant à savoir tester dans mon fichier final.
J’abandonne donc pour ce soir et verrais ça demain
Cordialement

Philippe
 

fenec

XLDnaute Impliqué
Re : Remplacer valeur cellules suite insertion ligne

Bonjour le forum, Job75

Avec votre dernier code seul le problème de décalage demeure dans l’onglet état de congés.

En cherchant à comprendre ce décalage j'ai remarqué que je n'avais pas le souci avec mon code de départ.
Le fait de traiter la Feuil2 avant la Feuil1 provoque ce décalage.

J’ai essayé d’inverser le traitement des feuilles mais ca ne marche pas
Est-il possible de remédier à ce problème ?

Ci-joint fichier avec dernier code et commentaire

Cordialement

Philippe
 

Pièces jointes

  • exemple4.xls
    549.5 KB · Affichages: 32
  • exemple4.xls
    549.5 KB · Affichages: 37
  • exemple4.xls
    549.5 KB · Affichages: 28

fenec

XLDnaute Impliqué
Re : Remplacer valeur cellules suite insertion ligne

Re,
Je ne vois pas en quoi je complique, ma question de départ était je pense clair.
Vous y avez d'ailleur répondu en donnant une solution qui fonctionne mais un problème en découle donc pas ma faute.
Vous décider ne ne pas poursuivre ,c'est votre choix,j'accepte
Cordialement
Philippe
 

job75

XLDnaute Barbatruc
Re : Remplacer valeur cellules suite insertion ligne

Re,

J’ai essayé d’inverser le traitement des feuilles mais ca ne marche pas

Juste au cas où vous n'auriez pas inversé correctement l'ordre des feuilles :

Code:
Sub Mise_à_Jour2()
Dim a, code, n As Byte, c, cel As Range
a = Array(Feuil1, Feuil2) 'CodeNames des feuilles à traiter
code = Array("D712", "D727") 'codes à traiter
Application.ScreenUpdating = False
For Each c In code
  For n = 0 To UBound(a)
    Set cel = a(n).[B:B].Find(c, , xlValues, xlWhole, , xlPrevious)
    If Not cel Is Nothing Then
      cel(2).EntireRow.Insert 'ligne entière
      cel.Resize(, 12).Copy cel(2)
      cel.Resize(, 12) = cel.Resize(, 12).Value 'supprime les formules
      cel(2, 4) = IIf(n, DateAdd("yyyy", 1, cel(2, 4)), a(1).Cells(cel(2).Row - 1, "M"))
      cel(2, 5) = IIf(n, DateAdd("yyyy", 1, cel(2, 5)), 0)
    End If
  Next
Next
End Sub
Mais je n'irai pas plus loin.

A+
 

fenec

XLDnaute Impliqué
Re : Remplacer valeur cellules suite insertion ligne

Bonsoir le forum, Job 75

Venant de tester n'ai rien à rajouter en regardant votre code je m'aperçois que j'avais omis d'inversé l'ordre des feuilles

Vais essayer de poursuivre mon projet en espérant qu'une personne veuille bien prendre le relai.

C'est dommage vous avez résolu 95% de mes problèmes VBA, me restait une chose a traité.

Cordialement et qui sait, à une autre fois pour un conseil ou une aide VBA

Bonne soirée

Philippe
 

Discussions similaires

Statistiques des forums

Discussions
312 180
Messages
2 085 993
Membres
103 081
dernier inscrit
jeromeolivier.raymond@wat