PDA

View Full Version : VBA Copy An Paste Only Copying 1st Row



bloodmilksky
11-22-2016, 03:37 AM
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

KevO
11-22-2016, 04:38 AM
Does column B have any values in it?

try amending

Last = .Cells(Rows.Count, 2).End(xlUp).Row
to

Last = .Cells(Rows.Count, 4).End(xlUp).Row
which will make VBA look at the values in column D to select the last row

bloodmilksky
11-22-2016, 04:46 AM
Thank You. The Problem is that it thinks that B7 is the header and is copying that as well. Is there a way that I can amend the code so it wont do that and will only copy the rows that meet the criteria

KevO
11-22-2016, 05:06 AM
try amending

.Range("B7:D" & Last).SpecialCells(xlCellTypeVisible).Copy
to

.Range("B8:D" & Last).SpecialCells(xlCellTypeVisible).Copy

mana
11-22-2016, 05:07 AM
>.Range("B7:D" & Last).AutoFilter Field:=2


Column C is filtered.
Not column D. It's OK?



Option Explicit

Sub ADDTOORDERS()
Dim Sh As Worksheet, C As Worksheet, Last As Long

Set Sh = Sheets("Menu")
Set C = Sheets("LensOrder")

Last = Sh.Range("B" & Rows.Count).End(xlUp).Row

With Sh.Range("B7:D" & Last)
.AutoFilter
.AutoFilter Field:=2, Criteria1:=">0"
If .Columns(1).SpecialCells(xlCellTypeVisible).Count > 0 Then
Intersect(.Cells, .Offset(1)).Copy
C.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
.AutoFilter
End With

End Sub

bloodmilksky
11-22-2016, 05:17 AM
Hi,

its now copying all of the rows irregardless of value in D :(

KevO
11-22-2016, 05:37 AM
Please post the amended code you are now using

mana
11-23-2016, 02:18 AM
>.AutoFilter Field:=2, Criteria1:=">0"
>If .Columns(1).SpecialCells(xlCellTypeVisible).Count > 0 Then



Option Explicit

Sub ADDTOORDERS()
Dim Sh As Worksheet, C As Worksheet, Last As Long

Set Sh = Sheets("Menu")
Set C = Sheets("LensOrder")

Last = Sh.Range("B" & Rows.Count).End(xlUp).Row

With Sh.Range("B7:D" & Last)
.AutoFilter
.AutoFilter Field:=3, Criteria1:=">0"
If .Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
Intersect(.Cells, .Offset(1)).Copy
C.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
.AutoFilter
End With

End Sub