Vba 如何在Excel中复制表中的行

我需要创建一个宏，当某个列为true时，该宏将复制表中的所有行

我录制了一个宏，它告诉我：

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线程可能会有所帮助。

我写这篇文章的速度快得多。有一些逻辑可以避免复制第一列（行公式）。你也许可以不用它

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

---

所以你打算过滤它，然后只复制可见的行？特殊单元格SxlVisible将通过可见单元格。或者你打算使用一个如果a column=true，那么copy.entirerow吗？@Raystafarian第二个可能是更好的选择。