Объединение пустых ячеек по содержанию соседних столбцов

[OlgaK]

Подскажите пожалуйста!
Необходимо сделать так, чтобы пустые ячейки автоматически объединялись в столбцах A и В по содержимому в столбцах C и D при условии, что в столбцах C и D могут добавляться ячейки и под конец работы с таблицей была возможность добавить «Строку итогов»
Работаю в Excel 2013 года с «Умной таблицей» (в которой нет возможности объединить ячейки, да и при большом количестве страниц в ручную делать очень долго). Если есть возможность так работать в обычной таблице, то тоже приветствуется.
В прикрепленном файле образец Лист 1 «Задача», Лист 2 «Как должно быть».
Заранее спасибо!

[OlgaK]

Прикрепленный файл

[staniiislav]

Так попробуйте, но сначала преобразуйте умную таблицу в диапазон!:

Sub OlgaK()
Dim lRow&, i&,  j&, t
Application.ScreenUpdating = False
t = Timer
lRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 4 To lRow
    If Cells(i, 1) > 0 Then
        For j = i + 1 To lRow
            If Cells(j, 1) > 0 Then
                With Range(Cells(i, 1), Cells(j - 1, 1))
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .WrapText = True
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .ReadingOrder = xlContext
                    .MergeCells = True
                End With
                With Range(Cells(i, 2), Cells(j - 1, 2))
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .WrapText = True
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .ReadingOrder = xlContext
                    .MergeCells = True
                End With
                Exit For
            End If
        Next j
    i = j - 1
    End If
Next i
MsgBox "Время обработки: " & Timer - t, vbInformation, "Объединение"
Application.ScreenUpdating = True
End Sub

[OlgaK]

Всплывает окно "Run-time error '1004': нельзя установить свойство MergeCells класса Range"

[staniiislav]

Сообщение от OlgaK

Всплывает окно "Run-time error '1004': нельзя установить свойство MergeCells класса Range"

Так попробуйте, но сначала преобразуйте умную таблицу в диапазон!:

смотрите рисунок

[OlgaK]

Спасибо!
Работает. Еще проблема в том, что в столбцах С и D тоже могут быть пустые ячейки. Их нужно будет либо объединять, либо удалять. Это можно сделать одним махом?

[shanemac51]

ячейки оформлены таблицей

Sub WE130828()
Dim OBJ As ListObject
Dim NTAB As String
Dim NTEXT As String
For Each OBJ In Excel.Worksheets(1).ListObjects
NTAB = OBJ.Name
NTEXT = "" & OBJ.Range.Cells(1, 1)
Debug.Print NTAB, NTEXT
If NTEXT = "Номер п/п" Then
  Excel.Worksheets(1).ListObjects(NTAB).Unlist
  Exit For
End If
Next OBJ
OlgaK
End Sub

[staniiislav]

Сообщение от OlgaK

Спасибо!
Работает. Еще проблема в том, что в столбцах С и D тоже могут быть пустые ячейки. Их нужно будет либо объединять, либо удалять. Это можно сделать одним махом?

у Вас уже есть работающий макрос, немного поразберайтесь как он работает и допишите в него то что Вам нужно

[OlgaK]

Если бы я в них еще разбиралась. Я только умею их вставлять.
Но все равно спасибо!

[staniiislav]

Сообщение от OlgaK

Если бы я в них еще разбиралась. Я только умею их вставлять.
Но все равно спасибо!

напишите что именно нужно сделать на примере. Допустим ячейка С6 и D6 пустые, что нужно сделать?