Question

我整理了一个宏，它将搜索我所拥有的表中的列，并且只将该表中具有该列数值的行复制粘贴到电子表格的下一页上。按下按钮后会发生这种情况。我的代码如下：

Sub Button1_Click()
Dim r As Long, endRow As Long, pasteRowIndex As Long

Set WS = Worksheets("Sheet1")
With WS
    Set LastCell = .Cells(.Rows.Count, "C").End(xlUp)
    LastCellRowNumber = LastCell.Row
End With

'endRow = 20 of course it's best to retrieve the last used row number via a function
pasteRowIndex = 1

For r = 2 To LastCellRowNumber 'Loop through sheet1 and search for your criteria

    If IsNumeric(Cells(r, Columns("E").Column).Value) And Not IsEmpty(Cells(r, Columns("E").Column).Value) Then 'Found

            'Copy the current row
            Rows(r).Select
            Selection.Copy

            'Switch to the sheet where you want to paste it & paste
            Sheets("Sheet2").Select
            Rows(pasteRowIndex).Select
            ActiveSheet.Paste

            'Next time you find a match, it will be pasted in a new row
            pasteRowIndex = pasteRowIndex + 1

           'Switch back to your table & continue to search for your criteria
            Sheets("Sheet1").Select
    End If
Next r
End Sub

这有效，但我的问题是它用它们的公式复制行（一旦复制就变得无法使用），所以我需要某种特殊的粘贴来复制值。我试过这个，但要么一直收到错误，要么它的工作方式不一样..有人可以帮我查一下，并指出我正确的方向吗？

Sub Button1_Click()
Dim r As Long, endRow As Long, pasteRowIndex As Long, Location As Long

Set WS = Worksheets("Sheet1")
With WS
    Set LastCell = .Cells(.Rows.Count, "C").End(xlUp)
    LastCellRowNumber = LastCell.Row
End With

pasteRowIndex = 1

For r = 2 To LastCellRowNumber 'Loop through sheet1 and search for your criteria

    If IsNumeric(Cells(r, Columns("E").Column).Value) And Not IsEmpty(Cells(r, Columns("E").Column).Value) Then 'Found

            Location = 1
            'Copy the current row
            Rows(r).Select
            Selection.Copy

            'Switch to the sheet where you want to paste it & paste
            Sheets("Sheet2").Select
            Rows(pasteRowIndex).Select
            ActiveSheet.Range(Cells(Location, 1)).PasteSpecial xlPasteValues
            Application.CutCopyMode = False

            'Next time you find a match, it will be pasted in a new row
            pasteRowIndex = pasteRowIndex + 1
            Location = Location + 1
           'Switch back to your table & continue to search for your criteria
            Sheets("Sheet1").Select
    End If
Next r
End Sub

非常感谢你！

Answer 1

ActiveSheet.Range(Cells(Location, 1)).PasteSpecial xlPasteValues

您无法在范围内单独嵌套单元格 - 单元格已经是范围：

ActiveSheet.Cells(Location, 1).PasteSpecial xlPasteValues

调整宏vba模块以仅粘贴值而不是公式

1 个答案: