Форум по VBA и MS Office

Sub Сумма()

    Dim arrM(), arrNO(), strHeader As String
    Dim lr As Long, i As Long
   
   
    '1. Отключение монитора (чтобы ускорить работу макроса).
    Application.ScreenUpdating = False
   
    '2. Копирование данных в массив (чтобы ускорить работу макроса).
    ' Поиск последней строки в столбцах N:O.
    lr = Columns("N:O").Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False).Row
    ' Копирование данных в массив.
    arrNO() = Range("N3:O" & lr).Value
   
    '3. Создание ячеек в массиве "arrM" (сначала в него запишутся суммы).
    ReDim arrM(1 To UBound(arrNO, 1), 1 To 1)
   
    '4. Сложение и запись сумм в массив "arrM".
    For i = 1 To UBound(arrNO, 1) Step 1
        arrM(i, 1) = arrNO(i, 1) + arrNO(i, 2)
    Next i
   
    '5. Вставка сумм на лист.
    Range("M3").Resize(UBound(arrM, 1), 1).Value = arrM()
   
    '6. Перестановка столбцов. В умной таблице нельзя переставить столбцы, а можно создавать и удалять столбцы.
    ' Запоминания заголовка столбца N.
    strHeader = Range("N2").Value
    ' Вставка нового столбца.
    Columns("P").Insert
    ' Удаление столбца N.
    Columns("N").Delete
    ' Переименование заголовка у нового столбца.
        ' Сразу это сделать нельзя, т.к. в умной таблице не может быть двух одинаковых заголовков.
    Range("O2").Value = strHeader
   
    '7. Включение монитора.
    Application.ScreenUpdating = True
   
    '8. Сообщение.
    MsgBox "Готово.", vbInformation

End Sub