複製粘貼宏

Question

我有一個宏在列中搜索特定值，如果爲true，則將包含該值的所有行復制到不同的工作表。但是，它似乎不工作，因爲它只複製最後一行，而不是具有特定值的所有行。

基本上，我向B列輸入數據，列C通過VLOOKUP返回結果，列D列出TRUE/FALSE。當D列中的值返回TRUE時，我希望它複製整行並將其粘貼到另一個工作表中。

Private Sub CommandButton21_Click() 
    Dim LR As Long 
    Dim C As Range 
    Dim Test As Worksheet 
    Dim Pastesheet As Worksheet 

    'Find the last row with data in column C 
    LR = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row 

    'look at every cell in D2 onwards 
    For Each C In Range("D2:D" & LR) 
     If C.Value = True Then 

      'Copy code 
      Set Test = Worksheets("Test Sheet") ' Copy From this sheet 
      Set Pastesheet = Worksheets("Inventory") ' to this sheet 

      C.EntireRow.Copy ' copy the row from column D that meets that requirements 
      Pastesheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats   
     End If  
    Next C 
End Sub 

Answer 1

我猜你在A列中沒有任何東西。使用其他方法找到最後一行。當你的循環開始時加緊你的範圍。

這應該工作：

Private Sub CommandButton21_Click() 
    Dim LR As Long 
    Dim C As Range 
    Dim Test As Worksheet 
    Dim Pastesheet As Worksheet 
    Dim LastRowOnSheet As Long 

    'Find the last row with data in column C 
    LR = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row 

    'look at every cell in D2 onwards 

     Set Test = Worksheets("Test Sheet") ' Copy From this sheet 
     Set Pastesheet = Worksheets("Inventory") ' to this sheet 

    For Each C In Test.Range("D2:D" & LR).Cells 


    If C.Value = True Then '(you can actually type "if c.value then" but no difference) 

     'Copy code    

     LastRowOnSheet = Pastesheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row 

     C.EntireRow.Copy 'copy the row from column D that meets that requirements 

     Pastesheet.Cells(LastRowOnSheet + 1, 1).PasteSpecial xlPasteValuesAndNumberFormats 

    End If 

    Next C 

    End Sub 

@zshake該錯誤表明沒有定義的片材或片整體爲空白。 find命令沒有錯誤。測試以確保pasteSheet有效。你可以把這個在1行代碼上面的你在哪裏得到的錯誤做到這一點：

msgbox Pastesheet.name

如果顯示的工作表名稱，你是在紙張上良好。然後你可以測試一個地址：

Dim Wth as range 
Set Wth = Pastesheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious) 
if wth is nothing then 
msgbox "Cannot find a cell" 
else 
msgbox "found a cell at " & wth.address 
EndIf