Simplifier le code

[Ilino]

Forum Bonsoir
je souhaite simplifier le code ci dessous

'Renvoer a la ligne automatiquement cellule fusionnées
Set t = Intersect(Target, [E13:X13]) ' objet
If Not t Is Nothing Then Ajustement t, [E:X], [E:X], xlCenter 'IMPORTANT : ci dessus la fonction Ajustement

'Réserves 20
Set t = Intersect(Target, [B25:X25])
If Not t Is Nothing Then Ajustement t, [B:X], [B:X], xlLeft 'IMPORTANT : ci dessus la fonction Ajustement
Set t = Intersect(Target, [B26:X26])
If Not t Is Nothing Then Ajustement t, [B:X], [B:X], xlLeft 'IMPORTANT : ci dessus la fonction Ajustement
Set t = Intersect(Target, [B27:X27])
If Not t Is Nothing Then Ajustement t, [B:X], [B:X], xlLeft 'IMPORTANT : ci dessus la fonction Ajustement
Set t = Intersect(Target, [B28:X28])
If Not t Is Nothing Then Ajustement t, [B:X], [B:X], xlLeft 'IMPORTANT : ci dessus la fonction Ajustement
Set t = Intersect(Target, [B29:X29])
If Not t Is Nothing Then Ajustement t, [B:X], [B:X], xlLeft 'IMPORTANT : ci dessus la fonction Ajustement
Set t = Intersect(Target, [B30:X30])
If Not t Is Nothing Then Ajustement t, [B:X], [B:X], xlLeft 'IMPORTANT : ci dessus la fonction Ajustement
Set t = Intersect(Target, [B31:X31])
If Not t Is Nothing Then Ajustement t, [B:X], [B:X], xlLeft 'IMPORTANT : ci dessus la fonction Ajustement
Set t = Intersect(Target, [B32:X32])
If Not t Is Nothing Then Ajustement t, [B:X], [B:X], xlLeft 'IMPORTANT : ci dessus la fonction Ajustement
Set t = Intersect(Target, [B33:X33])
If Not t Is Nothing Then Ajustement t, [B:X], [B:X], xlLeft 'IMPORTANT : ci dessus la fonction Ajustement
Set t = Intersect(Target, [B34:X34])
If Not t Is Nothing Then Ajustement t, [B:X], [B:X], xlLeft 'IMPORTANT : ci dessus la fonction Ajustement
Set t = Intersect(Target, [B35:X35])
If Not t Is Nothing Then Ajustement t, [B:X], [B:X], xlLeft 'IMPORTANT : ci dessus la fonction Ajustement
Set t = Intersect(Target, [B36:X36])
If Not t Is Nothing Then Ajustement t, [B:X], [B:X], xlLeft 'IMPORTANT : ci dessus la fonction Ajustement
Set t = Intersect(Target, [B37:X37])
If Not t Is Nothing Then Ajustement t, [B:X], [B:X], xlLeft 'IMPORTANT : ci dessus la fonction Ajustement
Set t = Intersect(Target, [B38:X38])
If Not t Is Nothing Then Ajustement t, [B:X], [B:X], xlLeft 'IMPORTANT : ci dessus la fonction Ajustement
Set t = Intersect(Target, [B39:X39])
If Not t Is Nothing Then Ajustement t, [B:X], [B:X], xlLeft 'IMPORTANT : ci dessus la fonction Ajustement
Set t = Intersect(Target, [B40:X40])
If Not t Is Nothing Then Ajustement t, [B:X], [B:X], xlCenter 'IMPORTANT : ci dessus la fonction Ajustement
Set t = Intersect(Target, [B41:X41])
If Not t Is Nothing Then Ajustement t, [B:X], [B:X], xlCenter 'IMPORTANT : ci dessus la fonction Ajustement
Set t = Intersect(Target, [B42:X42])
If Not t Is Nothing Then Ajustement t, [B:X], [B:X], xlCenter 'IMPORTANT : ci dessus la fonction Ajustement
Set t = Intersect(Target, [B43:X43])
If Not t Is Nothing Then Ajustement t, [B:X], [B:X], xlCenter 'IMPORTANT : ci dessus la fonction Ajustement
Set t = Intersect(Target, [B44:X44])
If Not t Is Nothing Then Ajustement t, [B:X], [B:X], xlCenter 'IMPORTANT : ci dessus la fonction Ajustement

GRAZIE

 

[eriiic]

Re : Simplifier le code

Bonjour,

A tester, en l'absence de fichier :

'Réserves 20
    Set t = [B25:X25]
    For i = 0 To 20
        Set t2 = Intersect(Target, t.Offset(, i))
        If Not t2 Is Nothing Then Ajustement t2, [B:X], [B:X], xlLeft    'IMPORTANT : ci dessus la fonction Ajustement
    Next i

eric

 

[job75]

Re : Simplifier le code

Bonsoir Ilino, eriiiic,

Comme ceci on est sûr de ne pas se tromper :

Dim t As Range, r As Range
'-------
'Réserves 20
For Each r In [B25:X44].Rows
  Set t = Intersect(Target, r)
  If Not t Is Nothing Then Ajustement t, [B:X], [B:X], IIf(r.Row < 40, xlLeft, xlCenter)
Next

Bonne nuit.

 

[Ilino]

Re : Simplifier le code

Forum BONJOUR, eric BONJOUR, MAITRE bonjour
sans doute
problème résolut
grazie