复制粘贴宏

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