vba excel macro Membuat makro untuk membandingkan nilai sel lalu menyisipkan baris di antara set

Saya percaya bahwa gambar akan menunjukkan semuanya.

Yang pertama adalah sumber di mana makro harus menyisipkan baris antara set dan menghitung jumlah set. Satu set dibangun oleh kolom "I" / Subject. Misalnya set "Store Z01"

Itu seharusnya hasilnya:

Saya telah berusaha keras tetapi tidak berhasil ... Bantuan apa pun akan sangat dihargai, bahkan dalam menyelesaikan sebagian dari seluruh tugas.

Sub FindSets_and_Sum()
'
    ScreenUpdating = False
    Columns("A:j").Sort key1:=Range("i:i"), order1:=xlAscending, Header:=xlYes
    ActiveSheet.Range("i2").Select
    FirstItem = ActiveCell.Value
    SecondItem = ActiveCell.Offset(1, 0).Value
    Offsetcount = 1
    Rowoffset = 0
    myNum = 100
    'myNum = (Range("A" & Rows.Count).End(xlUp).Row)
    Do While myNum > 0
        If FirstItem = SecondItem Then
            Offsetcount = Offsetcount + 1
            Rowoffset = Rowoffset + 1
            SecondItem = ActiveCell.Offset(Offsetcount, 0).Value
        Else
            Set myActiveCell = ActiveCell
            Set MyActiveCell_01 = ActiveCell
            MyActiveRow_01 = ActiveCell.Row
            MyActiveColumn_01 = ActiveCell.Column
            Set myActiveWorksheet = ActiveSheet
            Set myActiveWorkbook = ActiveWorkbook
            Dim Report As Worksheet 'Set up your new worksheet variable.
            Set Report = Excel.ActiveSheet 'Assign the active sheet to the variable.
            mySum = WorksheetFunction.Sum(Range("j" & MyActiveRow_01 & ":j" & MyActiveRow_01 + Rowoffset))
            Report.Cells(MyActiveRow_01, MyActiveColumn_01 + 2).Value = mySum 'Add the function.
            mySum = 0
            ActiveCell.Offset(Offsetcount, 0).Rows("1:1").EntireRow.Select
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            myActiveWorkbook.Activate
            myActiveWorksheet.Activate
            myActiveCell.Activate
            Set MyActiveCell02 = ActiveCell
            Set MyActiveCell_02 = ActiveCell
            MyActiveRow_02 = ActiveCell.Row
            MyActiveColumn_02 = ActiveCell.Column

            ActiveCell.Offset(Offsetcount + 1, 0).Select
            If ActiveCell.Value = "" Then
                myNum = 0
            End If

            FirstItem = ActiveCell.Value
            SecondItem = ActiveCell.Offset(1, 0).Value
            Offsetcount = 1
            myNum = myNum - 1
            Rowoffset = 0
        End If
    Loop
    ScreenUpdating = True
End Sub