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有效。你可以把它放在上面的一行代码中，你会得到错误：

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

复制粘贴宏

1 个答案: