简体   繁体   中英

How to copy rows from one sheet to another based on criteria in column— paste only values and formatting (not formulas)?

This code works as expected to copy the cells given a value of "xxx" in column B. The issue is that it copies the entire row contents, including formulas. I would only like to copy the cell values and formatting, not formulas.

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

I've tried amending the last portion to read like

       .Rows(i).Copy 
       .Range("A" & j).PasteSpecial xlPasteValuesAndNumberFormats

However that attempts to paste the rows in the same worksheet (probably because it's under "With"). I haven't been able to change the destination of the pasting of the rows. Ideally I would like the copied rows to be pasted into Sheet3.

Instead of copy pasting use value=value such that:

.Rows(j).value = .rows(i).value

For moving to another sheet, you could add the sheet reference and a lastrow:

sheets(3).rows(sheets(3).cells(sheets(3).rows.count,1).end(xlup).offset(1,0).row).value = .rows(i).value

Edit1:

Using your j...

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM