Ok, be patient. This code takes for ever, but it copies all the accounts across then copies them up and puts a "To Delete" in column "D"
if the cell above is occupied it moves over 1 top right for the copy.
Maybe the real gurus can modify this to speed up process.
Sub combineAccounts()
Dim x, lr As Long
Dim ws As Worksheet
Dim aPtype As Variant

Application.ScreenUpdating = False


Set ws = Worksheets("S1-var")
    
    With ws
        lr = .Cells(Rows.Count, "A").End(xlUp).Row
        
        For x = lr To 3 Step -1
            Set pFnd = .Range("I1:DE1").Find(Left(Cells(x, "EC"), Len(Cells(x, "EC")) - 3), , Excel.xlValues)
            pFnd.Offset(x - 1).Value = Cells(x, 2).Value
        Next x
        
        For r = lr To 3 Step -1
            For c = 10 To 109
                If .Cells(r, "E") = .Cells(r - 1, "E") And _
                    Cells(r - 1, c).Value = "" Then
                    Cells(r, c).Copy Cells(r - 1, c)
                    Cells(r, "D").Value = "To Delete"
                ElseIf .Cells(r, "E") = .Cells(r - 1, "E") And _
                    Cells(r - 1, c).Value <> "" Then
                    Cells(r, c).Copy Cells(r - 1, c + 1)
                    Cells(r, "D").Value = "To Delete"         
                End If
            Next c
           'Cells(r, c).EntireRow.Delete
        Next r
    End With
    Application.ScreenUpdating = True
End Sub