当在列中找到单元格值时，复制行并粘贴到下方

Question

我对 VBA 的了解非常有限，所以希望我能解释一下我想做什么！我正在尝试复制一行，如果它在 J 列中有大于 0 的内容。

然后我想将这个复制的行插入到复制的单元格下方的新行中。

我希望循环遍历整个工作表，以便重复 J 中具有值的每一行，工作表中的数据大小不同，B 列中始终有一个值，直到数据结束。 ..

这是我失败的尝试..

 Sub Copy_Cells()
    For Each Objcell In ActiveSheet.Columns(10).Cells
    Do
     If Objcell.Value > 0 Then
         Objcell.EntireRow.Select
        Selection.Copy
        Selection.Insert Shift:=xlDown
         Exit Sub
         Loop Until IsEmpty(ActiveSheet.Columns(2).Cells)
    End If
Next Objcell

End Sub

Answer 1

Sub Copy_Cells()
   Dim totalRow as Integer
   totalRow = Activesheet.Cells(1,2).End(xlDown).Row 'Count total row from B column
   For Each Objcell In Activesheet.Range("J1:J" & totalRow)
       If Objcell.Value > 0 Then
            Objcell.EntireRow.Select
            Selection.Copy
            Selection.Insert Shift:=xlDown
       End If
   Next Objcell
End Sub

Answer 2

我想这就是你想要做的。

Sub Copy_Cells()
    botRow = 100
    For i = botRow To 1 Step -1
      If Cells(i, 10).Value > 0 Then
        Rows(i).EntireRow.Copy
        Rows(i + 1).Insert Shift:=xlDown
      End If
   Next i
End Sub

您需要设置底行，或者您可以实现已用行的计数等。

当在列中找到单元格值时，复制行并粘贴到下方

Copy row and paste below when cell value found in a column

excel

vba

if-statement

copy-paste