VBA从基于条件的命名范围复制到另一个工作表中粘贴Vlaues

我有一个命名范围“数量”（工作表Sheet1，单元格I21：L28）有公式，报告数量在列“L”。 我想search列L值> 0，然后将这些值（连同来自K列的数据）粘贴到另一个工作表（Sheet10）。 下面的代码是closures的，但它粘贴的公式不是值。 请协助。

Sub CopyOnCondition() Dim sh1 As Worksheet, sh2 As Worksheet, c As Range Set sh1 = Sheet1 'Edit sheet name Set sh2 = Sheet10 'Edit sheet name With sh1 For Each c In .Range("L18:L24") If c.Value > 0 Then c.Copy sh2.Cells(Rows.Count, 1).End(xlUp)(2, 1) End If Next End With End Sub 

Answer 1

当列L> 0中的值时，下面的代码将仅复制Columns K：L中的值。

 Sub CopyOnCondition() Dim sh1 As Worksheet, sh2 As Worksheet, c As Range Set sh1 = Sheet1 'Edit sheet name Set sh2 = Sheet10 'Edit sheet name With sh1 For Each c In .Range("L18:L24") If c.Value > 0 Then c.Offset(, -1).Resize(1, 2).Copy '<-- copy column K with L ' paste values to the first empty row in Column A of sh2 sh2.Cells(sh2.Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlValues End If Next c End With End Sub 

Answer 2

尝试这个

 Sub CopyOnCondition() Dim sh1 As Worksheet, sh2 As Worksheet, c As Range Set sh1 = Sheet1 'Edit sheet name Set sh2 = Sheet10 'Edit sheet name With sh1 For Each c In .Range("L18:L24") If c.Value > 0 Then sh2.Cells(Rows.Count, 1).End(xlUp)(2, 1).resize(,2).value=c.offset(,-1).resize(,2).value End If Next End With End Sub