VBA Перемещение строк из одной таблицы в другую в зависимости от условия
У меня есть рабочая книга с 4 вкладками: 1 основная, ежедневно обновляемая вкладка и 3 вкладки, в которых будут храниться исторические данные.
На каждой вкладке есть разные таблицы, но я назвал их все.
Теперь одна из таблиц главной ежедневно обновляемой панели инструментов называется «Проблемы». Шестой столбец в этой таблице — «Статус». Мне нужен макрос, который будет автоматически перемещать строку данных из таблицы "Проблемы" в другую таблицу под названием "ПроблемыРешенные" на другом листе под названием "Проблемы", если статус проблемы установлен как "Решено" или "Отклонено"
Таблицы выглядят так:
Я уже написал код:
a = ActiveWorkbook.Worksheets("Current DMB Template").ListObjects("Problems").Range.Rows.Count
For i = 2 To a
If ActiveWorkbook.Worksheets("Current DMB Template").ListObjects("Problems").Cells(i, 6).Value = "Rejected" Or "Solved" Then
ActiveWorkbook.Worksheets("Current DMB Template").ListObjects("Problems").Rows(i).Cut
ActiveWorkbook.Worksheets("Problems").Activate
b = ActiveSheet.ListObjects("ProblemsSolved").Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.ListObjects("ProblemsSolved").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Current DMB Template ").Activate
End If
Next
End Sub
Но это дает мне ошибку 438, говорящую, что объект не поддерживает этот метод.
Помогите пожалуйста, что я делаю не так.
PS. было бы также здорово, если бы вы знали код для автоматического перемещения данных вверх после вырезания строки из первой таблицы.
Спасибо заранее
Также A = x Or y является неправильным. Нужно использовать A = x Or A = y
Большой! Спасибо. Но в этом случае он все равно будет учитывать таблицу, верно? То есть если таблица расширится на дополнительные строки, то макрос будет действителен еще?
Ответы 1
Было бы полезно использовать несколько переменных, чтобы сделать ваш код менее повторяющимся и более простым в обслуживании. Вот один подход:
Sub MoveClosed()
Dim wb As Workbook, loOpen As ListObject, loClosed As ListObject
Dim lr As ListRow, i As Long
Set wb = ThisWorkbook 'or ActiveWorkbook
'get a reference to each of the tables...
Set loOpen = wb.Worksheets("Current DMB Template").ListObjects("Problems")
Set loClosed = wb.Worksheets("Problems").ListObjects("ProblemsSolved")
For i = loOpen.ListRows.Count To 1 Step -1 'loop backwards
Set lr = loOpen.ListRows(i) 'reference the row
Select Case lr.Range.Cells(6).Value
Case "Rejected", "Solved" 'move this row?
lr.Range.Copy loClosed.ListRows.Add.Range.Cells(1)
lr.Delete
End Select
Next i
End Sub
Привет @Tim Большое спасибо, это сработало. Я новичок, самоучка в VBA и, честно говоря, я бы никогда не разобрался в этом. Всего одно исправление, которое я внес в ваш код: lr.Range.ClearContents работает намного лучше, так как основная панель инструментов беспорядок - десятки ячеек объединены, а столбцы скрыты , поэтому с вашим кодом после удаления строки она выглядела как текстовый документ после вставки изображения, а с очисткой содержимого это работает. Еще раз большое спасибо!
Приятно слышать, что это сработало.
У
ListObjectнет методаCellsили методаRows. Вы бы либо ссылались на.Range.Cells(который включает заголовок таблицы), либо на.DataBodyRange.Cells(который исключает заголовок).