VBA - Copy Row to another Sheet matching a criteria

[BradH]

I came across and modified the following VBA script, and it works exactly how I want, problem is, it copies formulas to new sheet, and I want it to copy the value only. Can anyone help with how to modify it to do this?

Dim LSearchRow As Integer
    Dim LCopyToRow As Integer

    On Error GoTo Err_Execute

    'Start search in row 4
    LSearchRow = 2

    'Start copying data to row 2 in Changes (row counter variable)
    LCopyToRow = 2

    While Len(Range("A" & CStr(LSearchRow)).Value) > 0

        'If value in column E = "Mail Box", copy entire row to Sheet2
        If Range("A" & CStr(LSearchRow)).Value = "C" Then

            'Select row in Sheet1 to copy
            Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
            Selection.Copy

            'Paste row into Sheet2 in next row
            Sheets("Changes").Select
            Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
            ActiveSheet.Paste

            'Move counter to next row
            LCopyToRow = LCopyToRow + 1

            'Go back to Sheet1 to continue searching
            Sheets("Verification").Select

        End If

        LSearchRow = LSearchRow + 1

    Wend

    'Position on cell A3
    Application.CutCopyMode = False
    Range("A3").Select

    MsgBox "All matching data has been copied."

    Exit Sub

Err_Execute:
    MsgBox "An error occurred."

 

[AlphaFrog]

This copies the values only. Also, it uses the .Autofilter feature to find the "C" rows instead of looping through each row one at a time.

[color=darkblue]Sub[/color] Copy_Changed_Rows()

    [color=darkblue]Dim[/color] Lastrow [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    [color=darkblue]With[/color] Sheets("Verification")
    
        [color=darkblue]If[/color] .Range("A:A").Find("C", , xlValues, xlWhole, , , [color=darkblue]False[/color]) [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
            MsgBox "No ""Changed"" rows found. ", , "No Rows Copied": [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
        [color=darkblue]Else[/color]
        
            Application.ScreenUpdating = [color=darkblue]False[/color]
        
            Lastrow = .Range("A" & Rows.Count).End(xlUp).Row
            .Range("A1:A" & Lastrow).AutoFilter Field:=1, Criteria1:="C"
            .Range("A2:A" & Lastrow).SpecialCells(xlCellTypeVisible).EntireRow.Copy
            Sheets("Changes").Range("A2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, [color=darkblue]False[/color], [color=darkblue]False[/color]
            .AutoFilterMode = [color=darkblue]False[/color]
            
            [color=green]'Position on cell A3[/color]
            [color=darkblue]With[/color] Application
                .CutCopyMode = False
                .Goto Sheets("Verification").Range("A3")
                .ScreenUpdating = [color=darkblue]True[/color]
            [color=darkblue]End[/color] [color=darkblue]With[/color]
            
            MsgBox "All matching data has been copied.", , "Copy Complete"
            
        [color=darkblue]End[/color] [color=darkblue]If[/color]
        
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

 

[JmanRueng]

How can you do this same task but ensure that only 10 rows (max) are returned/copied to the new location? In otherwords, autofilter may find 15 rows of data but I want the first 10 max, in every case, as the list will be sorted from largest to smallest.

 

[AlphaFrog]

How can you do this same task but ensure that only 10 rows (max) are returned/copied to the new location? In otherwords, autofilter may find 15 rows of data but I want the first 10 max, in every case, as the list will be sorted from largest to smallest.

Your description is a bit vague. It depends on the nature of your data.

Below is an example of filtering on column A and copying all the match rows. Then it clears the rows beyond Row 11 on the destination sheet. So rows 2-11 are your top 10.

[COLOR=darkblue]Sub[/COLOR] Copy_Changed_Rows()
    
    [COLOR=darkblue]Dim[/COLOR] Lastrow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    
    [COLOR=darkblue]With[/COLOR] Sheets("Verification")
    
        [COLOR=darkblue]If[/COLOR] .Range("A:A").Find("C", , xlValues, xlWhole, , , [COLOR=darkblue]False[/COLOR]) [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR]
            MsgBox "No ""Changed"" rows found. ", , "No Rows Copied": [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
        [COLOR=darkblue]Else[/COLOR]
        
            Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
        
            Lastrow = .Range("A" & Rows.Count).End(xlUp).Row
            .Range("A1:A" & Lastrow).AutoFilter Field:=1, Criteria1:="C"
            .Range("A2:A" & Lastrow).SpecialCells(xlCellTypeVisible).EntireRow.Copy
            [COLOR=darkblue]With[/COLOR] Sheets("Changes")
                .Range("A2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, [COLOR=darkblue]False[/COLOR], [COLOR=darkblue]False[/COLOR]
[B]                [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] IsEmpty(.Range("A12")) [COLOR=darkblue]Then[/COLOR] .Range("A12", .Range("A" & Rows.Count).End(xlUp)).EntireRow.ClearContents[/B]
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
            .AutoFilterMode = [COLOR=darkblue]False[/COLOR]
            
            [COLOR=green]'Position on cell A3[/COLOR]
            [COLOR=darkblue]With[/COLOR] Application
                .CutCopyMode = False
                .Goto Sheets("Verification").Range("A3")
                .ScreenUpdating = [COLOR=darkblue]True[/COLOR]
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
            
            MsgBox "All matching data has been copied.", , "Copy Complete"
            
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]