Option Explicit
Sub Test()
Dim i As Long
Application.ScreenUpdating = False
Application.Calculation = xlManual
With Worksheets("Feuil1") 'Nom de feuille à adapter
For i = .Range("F" & Rows.Count).End(xlUp).Row To 1 Step -1
If .Range("F" & i).Offset(1).Value <> "" And .Range("F" & i).Value <> "" Then
.Range("A" & i).Offset(1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next i
End With
Application.Calculation = xlAutomatic
End Sub