Sub InsererLignes()
Dim ligne As Long
Dim calMode As XlCalculation
'Pour aller plus vite
On Error GoTo FinInsertionLignes
With Application
calMode = .Calculation
.ScreenUpdating = False
.EnableEvents = False
.calculcation = xlManual
End With
With ActiveSheet
For ligne = .Cells(.Rows.Count, 1).End(xlUp).Row To 3 Step -1
With .Cells(ligne, 1)
If .MergeCells Then .UnMerge
If Not .Offset(-1).MergeCells Then
.EntireRow.Insert xlShiftDown
Else
ligne = ligne - 1
End If
End With
Next ligne
End With
'Rétablir les propriétés de départ de l'application
FinInsertionLignes:
With Application
.ScreenUpdating = True
.EnableEvents = True
.calculcation = calMode
End With
End Sub