如何在Excel中複製表格中的行

Question

我需要創建一個宏，該宏將在某個列爲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 

不過之前我深入研究它，我想知道什麼是最好的/最快的方法？

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