Une macro pour deux tableaux feuilles différentes

fenec · 21 Mai 2014

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

job75 · 22 Mai 2014

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 · 22 Mai 2014

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 · 22 Mai 2014

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.

job75 · 22 Mai 2014

Re : Une macro pour deux tableaux feuilles différentes

Re,

fenec à dit:
Nota 2 : pourriez vous être plus clair car j’ai retourné ma feuille « Acceuil « et n’ai rien remarqué de choquant sur l’orthographe.

Plus clair ? J'ai écrit ce mot avec la bonne orthographe au post #2.

A+

fenec · 22 Mai 2014

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.

Une macro pour deux tableaux feuilles différentes

fenec

XLDnaute Impliqué

Pièces jointes

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

fenec

XLDnaute Impliqué

job75

XLDnaute Barbatruc

fenec

XLDnaute Impliqué

Discussions similaires

Une macro pour deux tableaux feuilles différentes

fenec

XLDnaute Impliqué

Pièces jointes

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

fenec

XLDnaute Impliqué

job75

XLDnaute Barbatruc

fenec

XLDnaute Impliqué

Discussions similaires

Privacy & Transparency

Privacy & Transparency