XL 2013 Eviter saut de page sur cellule fusionnée

[mvcs]

Bonjour,
J'ai un tableau dont les cellules de la colonne A sont fusionnées car elles regroupent plusieurs lignes des colonnes suivantes.
Je souhaite faire en sorte que les cellules fusionnées ne soient pas couper par les saut de page automatiques.
J'ai cette macro qui aurait dû faire l'affaire :

Sub Macro1()
' Déplace les sauts de page pour éviter de couper les cellules fusionnées
Dim X As HPageBreak
For Each X In ActiveSheet.HPageBreaks
If X.Location.Address(0, 0) <> X.Location.MergeArea(1).Address(0, 0) Then
ActiveSheet.HPageBreaks.Add before:=X.Location.MergeArea(1)
End If
Next X
End Sub

Le problème auquel je suis confronté est qu'elle fonctionne parfaitement lorsque je la teste en "pas à pas" (F8). Les sauts de page sont bien décalés au-dessus de la cellule fusionnée intersectée.
Mais lorsque je l'exécute normalement, certains anciens sauts de page automatiques coupant les cellules fusionnées restent.

Merci si quelqu'un peut m'aider.
Manu
En pièce jointe, mon fichier anonymisé.

 

[youky(BJ)]

Bonjour,
Essayez comme ceci.
Oups je viens de voir que j'ai laissé la ligne .....select
J'ai pas testé sans alors je l'ai laissé
Bruno

Sub Macro1()
' Déplace les sauts de page pour éviter de couper les cellules fusionnées
    Dim X As HPageBreak
   ActiveSheet.ResetAllPageBreaks
For Each X In ActiveSheet.HPageBreaks
    If X.Location.Address(0, 0) <> X.Location.MergeArea(1).Address(0, 0) Then
    Cells(X.Location.MergeArea(1).Row, 1).Select
        ActiveSheet.HPageBreaks.Add before:=Cells(X.Location.MergeArea(1).Row, 1)
    End If
Next X
End Sub

 

[youky(BJ)]

Plus dans l'esprit de la macro
Ce qui est bizarre si on ne sélectionne pas la cellule le saut ne se fait pas.
Bruno

Sub Macro1()
' Déplace les sauts de page pour éviter de couper les cellules fusionnées
    Dim X As HPageBreak
   ActiveSheet.ResetAllPageBreaks
For Each X In ActiveSheet.HPageBreaks
    If X.Location.Address(0, 0) <> X.Location.MergeArea(1).Address(0, 0) Then
    X.Location.MergeArea(1).Select
        ActiveSheet.HPageBreaks.Add before:=X.Location.MergeArea(1)
    End If
Next X
End Sub

 

[mvcs]

Bonjour Bruno,
Super, ça fonctionne parfaitement.
Merci beaucoup du coup de main.