This kind of works, we run into issues where the numbers in column B are greater than the average, it is the best I have for now.

Sub Button1_Click()
    Dim sh As Worksheet, ws As Worksheet
    Dim rng As Range, LstRw As Long
    Dim x As Long, y As Long, av As Long
    Dim sm As Long, r As Long, r1 As Long, i, L

    Set sh = Sheets("Sheet1")
    Set ws = Sheets("Sheet2")

    With sh
        LstRw = .Cells(.Rows.Count, "B").End(xlUp).Row
        Set rng = .Range("B2:B" & LstRw)
        .Range("C2:C" & LstRw).ClearContents

    End With

    x = Application.WorksheetFunction.CountA(ws.Range("A:A")) - 1
    y = Application.Sum(rng)
    av = Fix(y / x)
    k = 1

    r1 = sh.Cells(sh.Rows.Count, "C").End(xlUp).Row + 1
    If r1 = 2 Then r1 = 2
    L = 1
    For i = 2 To LstRw

        r1 = sh.Cells(sh.Rows.Count, "C").End(xlUp).Row + 1
        If r1 = 2 Then r1 = 2

        sm = sh.Cells(i, 2) + sm
        If sm > av Then
            k = k + 1
            r = sh.Cells(i, 2).Row - 1
            sh.Range("C" & r1 & ":C" & r).Value = ws.Cells(k, "A").Value
            sm = 0
            i = i - 1
        End If
        L = L + 1
        If L >= LstRw Then Exit Sub
    Next i



End Sub