Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/excel/27.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181

Warning: file_get_contents(/data/phpspider/zhask/data//catemap/4/macos/10.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
根据单元格中的数字在VBA中复制粘贴_Vba_Excel - Fatal编程技术网

根据单元格中的数字在VBA中复制粘贴

根据单元格中的数字在VBA中复制粘贴,vba,excel,Vba,Excel,是否可以让VBA代码检查表1中B、E、H、K、N列的数字是否大于0,然后复制并粘贴该单元格,即表2中a、B和C列的前一个单元格和后一个单元格 这是我一直在使用的代码,但它占用了整行,这并不是我想要的,因为它提供了很多不必要的内容: Sub Epicerie() For Each Cell In Sheets("Liste").Range("B:B, E:E, H:H, K:K, N:N") If Cell.Value > 0 Then matchRow = Ce

是否可以让VBA代码检查表1中B、E、H、K、N列的数字是否大于0,然后复制并粘贴该单元格,即表2中a、B和C列的前一个单元格和后一个单元格

这是我一直在使用的代码,但它占用了整行,这并不是我想要的,因为它提供了很多不必要的内容:

Sub Epicerie()

For Each Cell In Sheets("Liste").Range("B:B, E:E, H:H, K:K, N:N")

    If Cell.Value > 0 Then
        matchRow = Cell.Row
        Rows(matchRow & ":" & matchRow).Select
        Selection.Copy

        Sheets("Listepret").Select
        ActiveSheet.Rows(matchRow).Select
        ActiveSheet.Paste
        Sheets("Liste").Select
    End If
Next

End Sub

我想你想要的是下面的代码:

Option Explicit

Sub Epicerie()

Dim Cell As Range

For Each Cell In Sheets("Liste").Range("B:B, E:E, H:H, K:K, N:N")
    If Cell.Value > 0 Then
        With Sheets("Listepret")
            ' copy paste in 1 line to the next empty row at Column "A"
            Cell.Offset(, -1).Resize(1, 3).Copy Destination:=.Range("A" & .Cells(.Rows.Count, "A").End(xlUp).Row + 1)
        End With
    End If
Next

End Sub
“我想要”不是一个问题。投递前阅读