VBA匹配标准和粘贴

我需要这个代码来searchsheet1中的一个表，并在符合特定条件的行上进行复制，

任何提示我要去哪里错了？

Sub find_orders() Application.ScreenUpdating = False Dim r As Long, endRow As Long, pasteRowIndex As Long endRow = Sheets("sheet1").Cells(Rows.Count, 2).End(xlUp).Row pasteRowIndex = 2 For r = 2 To endRow If Cells(r, 6) = "d" Then Range(Cells(r, 2), Cells(r, 6)).Copy Sheets("sheet2").Select Range(Cells(pasteRowIndex, 2), Cells(pasteRowIndex, 6)).Select pasteRowIndex = pasteRowIndex + 1 Sheets("sheet1").Select End If Next r End Sub 

Answer 1

正如@findwindow所说的，你需要限定所有的范围和单元格：

 Sub find_orders() Application.ScreenUpdating = False Dim r As Long, endRow As Long, pasteRowIndex As Long Dim ows As ws Dim tws As ws Set ows = Sheets("Sheet1") Set tws = Sheets("Sheet2") With ows endRow = .Cells(Rows.Count, 2).End(xlUp).Row pasteRowIndex = 2 For r = 2 To endRow If .Cells(r, 6) = "d" Then .Range(.Cells(r, 2), .Cells(r, 6)).Copy tws.Range(tws.Cells(pasteRowIndex, 2), tws.Cells(pasteRowIndex, 6)).PasteSpecial pasteRowIndex = pasteRowIndex + 1 End If Next r End With End Sub 

通过限定范围，您可以避免使用.Select命令。 这减慢了代码。

Answer 2

尝试以下操作：

 Sub find_orders() Application.ScreenUpdating = False Dim r As Long Dim endRow1 As Long Dim endRow2 As Long endRow1 = Sheets("sheet1").Cells(Sheets("sheet1").Rows.Count, 2).End(xlUp).Row endRow2 = Sheets("sheet2").Cells(Sheets("sheet2").Rows.Count, 2).End(xlUp).Row endRow2 = endRow2 + 1 For r = 2 To endRow If Cells(r, 6) = "d" Then 'searches in column f for the letter "d" in a cell, correct? Range(Cells(r, 2), Cells(r, 6)).Select Selection.Copy Sheets("sheet2").Select Range(Cells(endrow2, 2), Cells(endrow, 6)).Select Selection.Paste Sheets("sheet1").Select End If Next r End Sub 

问题是在你的代码中，pasteRowIndex始终是2，因为你已经在if循环之前定义了它（我有同样的问题一次）。 我还在代码中添加了更多的信息，因为在VBA中尤其如此，特别是在这方面总是很好的;）