Insert row if the value of a column changes

Try:

Sub InsertRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim x As Long
    On Error Resume Next
    For x = LastRow To 1 Step -1
        If Cells(x, "F") <> Cells(x - 1, "F") Then
            Rows(x).EntireRow.Insert
        End If
    Next x
    Rows(1).EntireRow.Delete
    Application.ScreenUpdating = True
End Sub