调整宏 vba 模块以仅粘贴值而不是公式
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/17644468/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Tweak a macro vba module to paste values only not formulas
提问by 5attab
I put together a macro that will search through a column in a table I have and ONLY copy-paste the rows of that table which have a numerical value in that column onto the next sheet of the spreadsheet. This happens once a button is pressed. My code is as follows:
我将一个宏放在一起，该宏将搜索我拥有的表格中的一列，并且仅将该表格中在该列中具有数值的行复制粘贴到电子表格的下一张纸上。一旦按下按钮，就会发生这种情况。我的代码如下：
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
This works but my problem with it is that it copies the rows with their formulas (which become unusable once copied), so I needed some sort of paste special to only copy the values. I tried this but either keep getting errors or it doesn't work the same way.. can someone please check it for me and point me in the right direction?
这有效，但我的问题是它复制带有公式的行（一旦复制就无法使用），所以我需要某种特殊的粘贴来只复制值。我试过这个，但要么不断出错，要么以同样的方式工作..有人可以帮我检查一下并指出正确的方向吗？
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
Thank you so much!
非常感谢！
回答by Andy G
ActiveSheet.Range(Cells(Location, 1)).PasteSpecial xlPasteValues
You cannot nest Cells (singly) within Range - Cells is already a Range:
您不能在范围内嵌套单元格（单独） - 单元格已经是一个范围：
ActiveSheet.Cells(Location, 1).PasteSpecial xlPasteValues
