Une macro pour deux tableaux feuilles différentes

fenec

XLDnaute Impliqué
Bonjour le forum

Il y a quelque temps, Job75 m’a aidé à insérer des lignes suivant des critères grâce à un code qui fonctionne très bien.
J’aurais aimé savoir s’il est possible que ce code interagisse sur mes deux tableaux mais que pour l’insertion des lignes en fonction des critères.

J’espère avoir été assez précis.

Cordialement

Philippe
 

Pièces jointes

  • Macro 2 feuilles.xls
    543 KB · Affichages: 35

job75

XLDnaute Barbatruc
Re : Une macro pour deux tableaux feuilles différentes

Bonjour fenec, le forum,

On ne peut pas dire que vous soyez d'une clarté limpide mais voyez ceci :

Code:
Sub Mise_à_Jour()
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).Resize(, 12).Insert xlDown
      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))
      If IsDate(cel(2, 5)) Then cel(2, 5) = DateAdd("yyyy", 1, cel(2, 5))
    End If
  Next
Next
End Sub
Nota 1 : vos formules de calcul des "Droit Prév" et "Droit Réel" pour "D712" sont sûrement à revoir...

Nota 2 : soignez l'orthographe d'Accueil, ça fait mal aux yeux...

A+
 

job75

XLDnaute Barbatruc
Re : Une macro pour deux tableaux feuilles différentes

Re,

Dans les feuilles les lignes n'ont pas toutes la même hauteur, il faut donc insérer des lignes entières :

Code:
Sub Mise_à_Jour()
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))
      If IsDate(cel(2, 5)) Then cel(2, 5) = DateAdd("yyyy", 1, cel(2, 5))
    End If
  Next
Next
End Sub
A+
 

fenec

XLDnaute Impliqué
Re : Une macro pour deux tableaux feuilles différentes

Bonsoir le forum, Job75

Déjà merci pour ton aide.
Viens de tester tes propositions qui fonctionnent comme je le souhaite.
J’avais remarqué la hauteur des lignes différentes mais ta 2ème solution corrige le problème rien à dire bravo et bien vu.

Pour tes remarques poste #2

Nota 1 : oui je sais mes formules sont tordues, je m’oriente sur une formule « Index » ou « Recherche V » mais comme elles fonctionnent je cherche à avancer dans mon projet en priorité.

Nota 2 : pourriez vous être plus clair car j’ai retourné ma feuille « Acceuil « et n’ai rien remarqué de choquant sur l’orthographe.
Eclairez moi donc sur ce point svp.

Cordialement

Philippe.
 

fenec

XLDnaute Impliqué
Re : Une macro pour deux tableaux feuilles différentes

Re le forum,Job75

Houla, j'ai honte, merci pour la précision je regardais dans la feuille et pas l'intitulé de l'onglet.
Pas seulement bon en vba, tu as l'oeil partout ":)"

Cordialement

Philippe.
 

Discussions similaires

Réponses
23
Affichages
1 K

Membres actuellement en ligne

Statistiques des forums

Discussions
315 246
Messages
2 117 750
Membres
113 300
dernier inscrit
faby79