VBA匹配條件並粘貼

Question

我需要這個代碼在Sheet1通過一個表來搜索和跨符合特定標準，該行復制，

在哪裏我錯了什麼祕訣？

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 

通過qualifieng你能避免使用.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，你有，如果環（我有同樣的問題一次）之前定義它。我還在代碼中增加了一些信息，因爲它總是很好，特別是在VBA中是非​​常具體的;）