Sub Accrocher()
'menu Exécution => Réinitialiser pour arrêter la macro
Dim SR&, i&
Do
DoEvents
If ActiveWorkbook.Name = ThisWorkbook.Name And ActiveSheet.CodeName = "Feuil1" Then
With ActiveWindow
If .Panes.Count = 2 Then
SR = .SplitRow + 1
For i = SR To .Panes(2).VisibleRange.Row
If i Mod 100 = 0 Then DoEvents
If ActiveSheet.Cells(i, 1).Interior.ColorIndex = 6 Then 'couleur jaune
Application.ScreenUpdating = False
ActiveSheet.Rows(i).Cut 'couper
ActiveSheet.Cells(SR, 1).Insert 'insérer les cellules coupées
.FreezePanes = False
.SplitRow = SR
.FreezePanes = True
Application.ScreenUpdating = True
Exit For 'traitement un par un
End If
Next
End If
End With
End If
Loop
End Sub