0

我整理了一个宏,它将搜索我拥有的表中的一列,并且仅将该表中在该列中具有数值的行复制粘贴到电子表格的下一张表中。一旦按下按钮,就会发生这种情况。我的代码如下:

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

太感谢了!

4

1 回答 1

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

您不能在 Range 中(单独)嵌套 Cells - Cells 已经是一个 Range:

ActiveSheet.Cells(Location, 1).PasteSpecial xlPasteValues
于 2013-07-14T22:42:33.230 回答