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