VBA將基於條件從命名范圍復制到另一個工作表中的粘貼Vlaues

Question

我有一個命名范圍“數量”（工作表Sheet1，單元格I21：L28），其公式在“ L”列中報告了數量。 我想在L列中搜索值> 0，然后將這些值（以及K列中的數據）粘貼到另一個工作表（Sheet10）中。 下面的代碼已關閉，但是粘貼了公式而不是值。 請協助。

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

嘗試這個

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

Answer 2

當L列中的值> 0時，以下代碼將僅從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