VBA Copy And Paste Only Copying 1st Row - vba

Question

I hope you are all well.
I am trying to use the below code to add orders of different products together. but only products with a value greater than 0 in column D. Unfortunately though the code for some reason is only copying the first row of the range, even though there are other rows which meet the criteria. can anyone help?
Sub ADDTOORDERS()
Dim Sh As Worksheet, C As Worksheet, Last As Long
Set Sh = Sheets("Menu")
Set C = Sheets("LensOrder")
With Sh
Last = .Cells(Rows.Count, 2).End(xlUp).Row
.Range("B7:D" & Last).AutoFilter Field:=2, Criteria1:=">0", Operator:=xlAnd
.Range("B7:D" & Last).SpecialCells(xlCellTypeVisible).Copy
C.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
Sheets("Menu").Range("C3").Select
.Range("B7:D" & Last).AutoFilter
End With
End Sub

Answer 1

Made only 1 change. check this. last row thing.
Sub ADDTOORDERS()
Dim Sh As Worksheet, C As Worksheet, Last As Long
Set Sh = Sheets("Menu")
Set C = Sheets("LensOrder")
With Sh
.Range("B7:D" & Last).AutoFilter Field:=2, Criteria1:=">0", Operator:=xlAnd
Last = .range("B500000").end(xlup).row
.Range("B7:D" & Last).SpecialCells(xlCellTypeVisible).Copy
C.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
Sheets("Menu").Range("C3").Select
.Range("B7:D" & Last).AutoFilter
End With
End Sub

Answer 2

The problem with your code is that your are trying to copy the resulting range, however that range has several areas, thus it's only copying the first area.
One of the methods to work in this situation is to pass the resulted range into an array then to post the array into the desired range.
This solution assumes the header is at row 6
Try the code below:
Option Base 1 'This must be at the top of the module
Sub Add_Orders()
Dim wshSrc As Worksheet, wshTrg As Worksheet
Dim rCpy As Range, aCpy() As Variant
Dim rArea As Range, rRow As Range
Dim lRowLst As Long, lRow As Long
With ThisWorkbook
Set wshSrc = .Worksheets("Menu")
Set wshTrg = .Worksheets("LensOrder")
End With
lRowLst = wshSrc.Cells(wshSrc.Rows.Count, 2).End(xlUp).Row
'' With wshSrc.Range("B7:D" & lRowLst) 'The filter should always include the header - Replacing this line
With wshSrc.Range("B6:D" & lRowLst) 'With this line
ReDim Preserve aCpy(.Rows.Count)
.AutoFilter Field:=3, Criteria1:=">0"
Set rCpy = .Rows(1).Offset(1).Resize(-1 + .Rows.Count).SpecialCells(xlCellTypeVisible) 'Use the offset and resize to exclude the header
End With
For Each rArea In rCpy.Areas
For Each rRow In rArea.Rows
lRow = 1 + lRow
aCpy(lRow) = rRow.Value2
Next: Next
ReDim Preserve aCpy(lRow)
aCpy = WorksheetFunction.Index(aCpy, 0, 0)
With wshTrg.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
.Cells(1).Resize(UBound(aCpy), UBound(aCpy, 2)).Value = aCpy
End With
End Sub
Suggest to read the following pages to gain a deeper understanding of the resources used:
For Each...Next Statement,
Option keyword,
Range Object (Excel),
Variables & Constants,
With Statement,