Copy & Paste when range meets criteria

[bloodmilksky]

Hi Guys, I hope you are all well.

I was just wondering if anyone would know how I can amend the below code so that it will only copy rows where the value in column D exceeds a Value of 0

any help would be greatly appreciated

Many thanks

jamie

    Sheets("Menu").Range("B7:D68").Copy
    Sheets("LensOrder").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
    Sheets("Menu").Range("C3").Select
    Selection.ClearContents
    Range("QTYS").Select
    Selection.ClearContents
    Range("C3").Selec

 

[dssJones]

If I understand you correctly you need the values from B thru D on Menu to be copied to LensOrder from A thru C starting on the last blank row of LensOrder.

Instead of a quick copy of the entire range my solution copies individual rows from Menu to LensOrder, if and only if the value in D is numeric, and is greater than zero. If not the solution just skips the row in Menu; it does not skip a row in LensOrder. If you would like it to skip a row in LensOrder when D=0 then change where it says
[pasteRow = pasteRow] to [pasteRow = pasteRow +1]

We have grown from two lines to a monster. You might want another VBA expert to look at this problem for a simpler solution. However, if my assumption was correct this code will work for you. If you like this, then please LIKE this.

Sub newCode()
    Dim rowNbr As Long
    Dim colNbr As Integer
    
    Dim Menu As Worksheet
    Set Menu = Sheets("Menu")
    
    Dim LensOrder As Worksheet
    Set LensOrder = Sheets("LensOrder")
    
    Dim startCol As Integer
    Dim startRow As Long
        startRow = 7
        startCol = 2
        
    Dim lastCol As Long
    Dim lastRow As Long
        lastRow = 68
        lastCol = 4
    
    Dim pasteCol As Integer
    Dim pasteRow As Long
        pasteRow = LensOrder.Cells(Rows.Count, 1).End(xlUp).Row + 1
        
    For rowNbr = startRow To lastRow
        pasteCol = 1
        If IsNumeric(Menu.Cells(rowNbr, lastCol).Value) Then
            If Menu.Cells(rowNbr, lastCol).Value > 0 Then
                For colNbr = startCol To lastCol
                    LensOrder.Cells(pasteRow, pasteCol).Value = Menu.Cells(rowNbr, colNbr).Value
                    pasteCol = pasteCol + 1
                Next colNbr
                pasteRow = pasteRow + 1
            Else
                pasteRow = pasteRow
            End If
        End If
    Next rowNbr
    
    Sheets("Menu").Range("C3").Select
    Selection.ClearContents
    Range("QTYS").Select
    Selection.ClearContents
    Range("C3").Selec
End Sub