Sub Procedure_1()

        Dim tblA() As Variant
        Dim i As Long
            
            
        '1. При вставке строк на Excel-лист нужно
            'обязательно отключать обновление монитора, чтобы
            'код работал быстро.
        Application.ScreenUpdating = False

            
        '2. Быстрее работать с VBA-таблицей (по научному - VBA-массив),
            'чем с Excel-листом, поэтому помещаем данные
            'из Excel-листа в VBA-таблицу.
        tblA() = Range("A1:A6").Value
            
            
        'Двигаемся по VBA-таблице от последней строки
            'к первой - так проще будет писать код.
        For i = UBound(tblA, 1) To 2 Step -1
            'Если данные в текущей ячейке VBA-таблицы
                'отличаются от данных в вышестоящей ячейке.
            If tblA(i, 1) <> tblA(i - 1, 1) Then
                    
                '4. Вставляем на Excel-лист пустую строку.
                    'Порядковые номера строк в VBA-таблице и Excel-листе совпадают.
                'Shift:=xlShiftDown - смещение текущей
                    'строки в Excel-листе вниз.
                    'Есть ещё вариант "xlShiftToRight" - смещение вправо.
                'CopyOrigin:=xlFormatFromRightOrBelow - форматировать
                    'вставленную строку также, как и строку ниже.
                    'Есть ещё вариант "xlFormatFromLeftOrAbove" -
                    'форматировать также, как строку, которая находится
                    'над вставленной строкой.
                Rows(i).Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromRightOrBelow
                     
            End If
        Next i
            
            
        '4. Включаем обновление монитора.
        Application.ScreenUpdating = True
            
End Sub

Sub Procedure_1()

           Dim tblA() As Variant
           Dim myLastRow As Long
           Dim i As Long
                 
           Application.ScreenUpdating = False
             
           'Определяем последнюю строку с данными по столбцу "A".
              'Макрос сделает действие аналогичное тому,
              'как в Excel сделать активной последнюю ячейку
              'в столбце "A" и нажать сочетание
              'клавиш "Ctrl + стрелка вверх".
           myLastRow = Cells(Rows.Count, "A").End(xlUp).Row

                 
           tblA() = Range("A1:A" & myLastRow).Value
                 
                 
           For i = UBound(tblA, 1) To 2 Step -1
               If tblA(i, 1) <> tblA(i - 1, 1) Then
                         
                   Rows(i).Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromRightOrBelow
                         
               End If
           Next i
                 
                 
           Application.ScreenUpdating = True
                 
End Sub

Sub Procedure_1()

     Dim tblA() As Variant
     Dim myLastRow As Long
     Dim i As Long
      
     Application.ScreenUpdating = False
      
     myLastRow = Cells(Rows.Count, "A").End(xlUp).Row
      
      
     tblA() = Range("A1:A" & myLastRow).Value
      
      
     For i = UBound(tblA, 1) To 2 Step -1
         If tblA(i, 1) <> tblA(i - 1, 1) Then
              
             'С помощью "Resize(2)" получаем доступ к двум строкам.
             Rows(i).Resize(2).Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromRightOrBelow
              
             'Делаем границу у ячеек в строке.
             With Rows(i).Borders(xlEdgeBottom)
                 .LineStyle = xlDash
                 .Weight = xlMedium
             End With
              
         End If
     Next i
      
      
     Application.ScreenUpdating = True
                   
End Sub

Sub Procedure_1()

      Dim tblA() As Variant
      Dim myLastRow As Long
      Dim i As Long
       
      Application.ScreenUpdating = False
       
      myLastRow = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row
       
      tblA() = Cells(1, ActiveCell.Column).Resize(myLastRow, 1).Value
       
       
      For i = UBound(tblA, 1) To 2 Step -1
          If tblA(i, 1) <> tblA(i - 1, 1) Then
               
              Rows(i).Resize(2).Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromRightOrBelow
               
              With Rows(i).Borders(xlEdgeBottom)
                  .LineStyle = xlDash
                  .Weight = xlMedium
              End With
               
          End If
      Next i
       
      Application.ScreenUpdating = True
                   
End Sub