Question

我需要创建一个宏，当某个列为真时，它会复制表的所有行。

我录制了一个宏，它给了我这个：

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

然而，在我深入研究之前，我想知道什么是最好/最快的方法？

Answer 1

这样的事情会起作用。根据需要修改

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线程可能会有所帮助，如果你想要清理一些Copy and Paste Table Row和Add row。

Answer 2

我最后写得更快了。有一些逻辑可以避免复制第一列（这是一个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

如何在Excel中复制表中的行

2 个答案: