Групировка строки

Sub Gruppa()
Dim I0 As Integer, J0 As Integer, Ik As Integer, Jk As Integer
Dim I As Integer, J As Integer
I0 = 1: J = 1: Jk = Cells(Rows.Count, 1).End(xlUp).Row
Do While I0 <= Jk
  Ik = I0 + 3
  If Ik > Jk Then Ik = Jk
  Range("A" & I0 & ":A" & Ik).Copy Destination:=Range("B" & J)
  If Ik = Jk Then Exit Do
  J = J + 4: I0 = I0 + 4
  J0 = Jk - 43
  If J0 < I0 Then J0 = I0
  Range("A" & J0 & ":A" & Jk).Copy Destination:=Range("B" & J)
  If J0 = I0 Then Exit Do
  J = J + 44: Jk = Jk - 44
Loop
End Sub

  Range("B" & J & ":B" & (J + Ik - I0)) = Range("A" & I0 & ":A" & Ik).Value 'вместо строки 8
  Range("B" & J & ":B" & (J + Jk - J0)) = Range("A" & J0 & ":A" & Jk).Value 'вместо строки 13

Sub Copy100()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
 
Dim lLastRow&: Dim lLastCol&: Dim n%
lLastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
lLastCol = ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1
 
n = 5
For i = lLastRow To 1 Step -1
    Rows(i & ":" & i).Copy
    Rows(i & ":" & i + n).Insert Shift:=xlDown
Next i
Range("A1").Activate
 
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
 
End Sub