Adding numbers from an array into a single cell

Try

Sub test()
    Dim myAreas As Areas, i As Long, ii As Long, a()
    With Sheets("sheet1")
        Set myAreas = .Columns("g").SpecialCells(-4123, 1).Areas
        ReDim a(1 To 1)
        For i = 2 To myAreas.Count Step 2
            If myAreas(i).Rows.Count = 1 Then
                If UBound(a) < myAreas(i).CurrentRegion.Columns.Count Then
                    ReDim a(1 To myAreas(i).CurrentRegion.Columns.Count)
                End If
                For ii = 1 To myAreas(i).CurrentRegion.Columns.Count
                    a(ii) = a(ii) + myAreas(i)(1, ii).Value
                Next
            End If
        Next
        .[g40].Resize(, UBound(a)).Value = a
    End With
End Sub