Как дублировать строки в таблице в Excel

Мне нужно создать макрос, который будет дублировать все строки таблицы, когда определенный столбец будет истинным.

Я записал макрос, и он дал мне следующее:

ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=4, Criteria1:= "TRUE" Range("Table1").Select Application.CutCopyMode = False Selection.Copy Range("A22").Select 'To be replaced with a method that finds the last cell. 'Selection.End(xlDown).Select gives me the last row in the table, but I want the one under that. ActiveSheet.Paste ActiveWindow.SmallScroll Down:=12 

Однако, прежде чем я вникаю в это, я хотел бы знать, какой будет лучший / быстрый подход?

Что-то вроде этого будет работать. Измените по мере необходимости

 Sub david() Application.CutCopyMode = True Dim lastrow As Integer Dim rCell As Range lastrow = ActiveSheet.ListObjects("Table1").ListRows.Count For Each rCell In ActiveSheet.ListObjects("Table1").ListColumns(2).DataBodyRange If rCell.Value = "True" Then ActiveSheet.ListObjects("Table1").ListRows.Add rCell.EntireRow.Copy ActiveSheet.ListObjects("Table1").ListRows(lastrow + 1).Range.PasteSpecial Paste:=xlPasteValues lastrow = lastrow + 1 End If Next Application.CutCopyMode = False End Sub 

Если у вас есть другие данные в той же строке на листе таблицы, вам может потребоваться скопировать определенный диапазон, а не .entirerow поскольку он будет собирать данные за пределами таблицы.

Эти два потока SO могут помочь, если вы хотите очистить его – Скопировать и вставить таблицу строк и добавить строку .

В конце концов я написал это гораздо быстрее. Существует некоторая логика, которая позволяет избежать копирования первого столбца (который является формулой Row (). Возможно, вы можете обойтись без него).

 Sub DuplicateRows(tableToDuplicate As String, columnToDetermineIfRowNeedsDuplication As Integer) Application.DisplayAlerts = False 'Excel is more efficient when copying whole ranges at once rather than row by row. Dim sourceRange As Range, destRange As Range Dim rowsToDelete As Range Set sourceRange = Range(tableToDuplicate) 'Copy source range except row num. Start at bottom of source range. Start at offset x + so that row number is not copied. Set sourceRange = sourceRange.Resize(sourceRange.Rows.Count, sourceRange.Columns.Count - 1) Set sourceRange = sourceRange.Offset(0, 1) ' We don't need to copy the first column. Set destRange = sourceRange.Offset(sourceRange.Rows.Count, 0) destRange.Value = sourceRange.Value 'Duplicate all values. Set rowsToDelete = destRange 'Get complete table now, unfiltered. rowsToDelete.AutoFilter columnToDetermineIfRowNeedsDuplication, Criteria1:="=FALSE" ' Find which ones we must delete. Set rowsToDelete = rowsToDelete.Offset(0, -1) Set rowsToDelete = rowsToDelete.Resize(rowsToDelete.Rows.Count, rowsToDelete.Columns.Count + 1) rowsToDelete.Rows.Delete End Sub 
Interesting Posts

Ошибка времени выполнения «9»: индекс за пределами допустимой области

Excel VBA: вводят код в sub для хранения журналов (временная метка)

C # Сохранить текстовый файл в Excel

Объявлять глобальную переменную для пароля листа

Добавление значений в столбцах с условиями

Может ли Excel с макросами (VBA) отключить вызов скрипта python

JFreeChartSeries Series Exception … "попытка добавить наблюдение за период времени …"

Импорт нескольких текстовых файлов Excel VBA

Как создать макрос, который принимает выделение из переключателя и комбинированного блока?

VBA: Мне нужно написать как функцию, так и вызывающий юг, чтобы сделать следующее

Как запустить SSH в Shell для возврата значений в переменную VBA?

Excel – поиск ключевого слова в TXT-файле и запись строки, где ключевое слово найдено в ячейке excel

Используйте powershell для сортировки колонки excel с заголовком

Отладка с использованием массивов в VBA

Вставить изображение в Excel – Java

Давайте будем гением компьютера.