![](/img/trans.png)
[英]Copy Cell values from One Sheet to Another on certain criteria with the paste
[英]How to copy rows from one sheet to another based on criteria in column— paste only values and formatting (not formulas)?
此代碼按預期工作,可以復制B列中給定值為“ xxx”的單元格。問題是它可以復制整個行的內容,包括公式。 我只想復制單元格的值和格式,而不是公式。
Sub CommandButton1_Click()
Dim LastRow As Long
Dim i As Long, j As Long
'Find the last used row in a Column: column A in this example (source sheet = sheet2)
With Worksheets("Sheet2")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
'Message box to confirm how many rows were scanned to ensure all rows were scanned
MsgBox ("Number of rows scanned: " & LastRow)
'First row number where you need to paste values in Sheet3 (destination sheet = sheet3)'
With Worksheets("Sheet3")
j = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
For i = 1 To LastRow
With Worksheets("Sheet2")
If .Cells(i, 2).Value = "xxx" Then
.Rows(i).Copy Destination:=Worksheets("Sheet3").Range("A" & j)
j = j + 1
End If
End With
Next i
End Sub
我嘗試將最后一部分修改為
.Rows(i).Copy
.Range("A" & j).PasteSpecial xlPasteValuesAndNumberFormats
但是,這試圖將行粘貼到同一工作表中(可能是因為它在“ With”下)。 我無法更改行粘貼的目的地。 理想情況下,我希望將復制的行粘貼到Sheet3中。
代替復制粘貼,使用value = value這樣:
.Rows(j).value = .rows(i).value
要移至另一張紙,可以添加紙參考和最后一行:
sheets(3).rows(sheets(3).cells(sheets(3).rows.count,1).end(xlup).offset(1,0).row).value = .rows(i).value
EDIT1:
正在使用您的...
sheets(3).rows(j).value = .rows(i).value
Public Function FilterByTable(fromWs As Worksheet, destWs As Worksheet, tableFilter As String) As Boolean
Dim copyFrom As Range
Dim lRow As Long
'Assume false
FilterByTable = False
With fromWs
.AutoFilterMode = False
'This gives the value for the last row in this range
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
With .Range("A1:A" & lRow)
'Looking for any row that meets this filter i.e. val=tableFilter
.AutoFilter Field:=1, Criteria1:="=" & tableFilter
Set copyFrom = .SpecialCells(xlCellTypeVisible).EntireRow
End With
.AutoFilterMode = False
End With
With destWs
'Some error checking since this will fail if you try to perform the operation on an empty data set
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
lRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
lRow = 1
End If
copyFrom.Copy .Rows(lRow)
End With
FilterByTable = True
End Function
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.