Comment intercaler deux à deux des lignes sous excel

Sub Macro1()
Dim dlig As Long, dlig2 As Long, l As Long, i As Long
Application.ScreenUpdating = False
With Sheets("Feuil1")
    .Columns("G:G").ClearContents
    dlig = .Cells(Rows.Count, 2).End(xlUp).Row
    .Range("B3:B" & dlig).Copy .Range("G3")
        For l = dlig To 3 Step -1
          .Cells(l + 1, 7).Insert Shift:=xlDown
        Next l
  
    dlig2 = .Cells(Rows.Count, 7).End(xlUp).Row
    
        For i = dlig2 + 1 To 4 Step -2
            .Cells(i, 7) = .Cells(dlig, 3)
            dlig = dlig - 1
        Next i
End With
Application.ScreenUpdating = True
End Sub

mod

Sub est()
Dim i As Long
For i = 3 To Cells(Rows.Count, 2).End(xlUp).Row
If i Mod 2 = 0 Then Cells(i, 2).Font.FontStyle = "Gras"
Next i
End Sub

Sub esv()
Dim i As Long
For i = Cells(Rows.Count, 2).End(xlUp).Row To 3 Step -3
Rows(i).Insert Shift:=xlDown
Next i
End Sub