Righe vuote

Option Explicit
Sub Inserisci_Riga()
    Dim ur     As Long
    Dim i      As Long
    Application.ScreenUpdating = False
    ur = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row 'rileva l'ultima riga di colonna A
    For i = ur To 2 Step -1                       'cicla dal basso verso l'alto la colonna A
        If Cells(i, 1).Value <> Cells(i - 1, 1).Value Then 'se dati diversi ...
            Cells(i, 1).EntireRow.Insert          '... inserisci riga vuota
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Option Explicit
Sub Inserisci_Riga_Con_Conta()
    Dim ur     As Long
    Dim i      As Long
    Dim conta  As Long
    Application.ScreenUpdating = False
    ur = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row 'rileva l'ultima riga di colonna A
    For i = ur To 2 Step -1                       'cicla dal basso verso l'alto la colonna A
        conta = conta + 1
        If Cells(i, 1).Value <> Cells(i - 1, 1).Value Then 'se dati diversi ...
            Cells(i, 1).EntireRow.Insert          '... inserisci riga vuota
            Cells(i + conta + 1, 1) = conta
            conta = 0
        End If
    Next i
    Cells(i + conta + 1, 1) = conta + 1
    Application.ScreenUpdating = True
End Sub

Sub NumeraRighe()
Dim x, ur, str
ur = Range("A" & Rows.Count).End(xlUp).Row
For x = ur To 1 Step -1
    If x = 1 Then
        str = Cells(x, 1): Cells(x, 1).EntireRow.Insert
        Cells(x, 1) = Application.WorksheetFunction.CountIf(Range("a:a"), str): Exit Sub
    Else
        If Cells(x, 1) <> Cells(x - 1, 1) Then
            str = Cells(x, 1): Cells(x, 1).EntireRow.Insert
            Cells(x, 1) = Application.WorksheetFunction.CountIf(Range("a:a"), str)
        End If
    End If
Next
End Sub

Option Explicit
Sub Inserisci_Riga_Con_Numero()
    Dim ur     As Long
    Dim i      As Long
    Dim conta  As Long
    Dim num    As Long
    Application.ScreenUpdating = False
    ur = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    For i = ur To 2 Step -1
        conta = conta + 1
        If Cells(i, 1).Value <> Cells(i - 1, 1).Value Then
            Cells(i, 1).EntireRow.Insert
            For num = 1 To conta
                Cells(i + num, 1) = Cells(i + num, 1) & ". " & conta
            Next num
            conta = 0
        End If
    Next i
    If conta = 0 Then
        Cells(1, 1) = Cells(1, 1) & ". 1"
    Else
        For num = 1 To conta + 1
            Cells(num, 1) = Cells(num, 1) & ". " & conta + 1
        Next num
    End If
    Application.ScreenUpdating = True
End Sub