Inserer une ligne vide entre deux ligne differentes

Sub insere_ligne()
Dim elm As Range
    With ActiveWorkbook.ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("I:I") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("I1").CurrentRegion
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    For Each elm In ActiveWorkbook.ActiveSheet.UsedRange.Columns("I").Cells
        If elm.Value <> "" And elm.Value <> elm.Offset(1).Value Then
            elm.Offset(1).EntireRow.Insert xlDown
        End If
    Next elm
End Sub