XL 2016 figer une image

Private Sub Workbook_Open()
Application.OnTime 1, "ThisWorkbook.ArrierePlan" 'lance la macro
End Sub

Private Sub ArrierePlan()
Dim P As Range, col%, lig&, t#
Set P = [MaZone] 'plage nommée
col = 2 'colonne de destination, à adapter
Do
    lig = ActiveWindow.ScrollRow 'mémorise la ligne
    t = Timer + 0.2 'temporisation de 0.2 seconde
    While Timer < t And t < 86400: DoEvents: Wend
    If ActiveWorkbook.Name = Me.Name Then If ActiveSheet.Name = P.Parent.Name Then _
        If ActiveWindow.ScrollRow <> lig Then P.Cut Cells(ActiveWindow.ScrollRow + 3, col) 'couper-coller
Loop
End Sub