VBA复制并粘贴只复制第一行
我希望你一切都好。VBA复制并粘贴只复制第一行
我正在尝试使用下面的代码将不同产品的订单添加到一起。但只有D列中值大于0的产品。不幸的是,尽管代码出于某种原因只复制范围的第一行,即使有其他行符合条件。谁能帮忙?
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
只做了1次更改。检查这个。最后一排的东西。
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
我已经通过它Praveen,并觉得这是真的很明显,但我不能看到错误。我知道它是这样的,我告诉它复制第一行,不管价值如何,但我不知道我在做什么。 –
我更新了代码。你检查过这个吗?? –
我运行你的一个,它仍然复制第一行b7,即使它没有任何价值 –
与您的代码的问题是,你要复制产生的范围,但是这个范围内有几个方面,因此它只是复制第一个区域。 在这种情况下工作的方法之一是将结果范围传递到数组中,然后将数组发布到期望的范围内。
该解决方案假定所述报头是在第6行
尝试下面的代码:
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
推荐阅读以下的页面,以获得所述资源的更深入的了解使用:
For Each...Next Statement , Option keyword, Range Object (Excel),
如果你想要D,你不应该检查字段3吗? – SJR
这样的白痴谢谢你。 @SJR我可以问,虽然我正在运行宏,但它总是复制范围的第一行,即使它不符合标准,为什么会这样? –
轻松完成!你的意思是它总是复制第7行或第8行? AF采用标题行,因此它将复制第一行。如果您没有任何标题,请添加标题行并将复制范围偏移1行。 – SJR