将A表中的数据行按条件插入B表中

lnvi

将《预算》表中，数量大于0且单位不为空的行，插入到《产品明细》表中。由于《预算》表中的列中有公式，插入到《产品明细》时，需要保留公式运算后的值。

非常非常感谢

不知道为什么

如图，不知是否是你需要的效果，供参考！

jnsxmt

是否符合你要求，请审阅

lnvi

jnsxmt 发表于 2018-6-7 17:32
是否符合你要求，请审阅

再请问一下。。。可以在《产品明细》中增加一个按钮，自动选中 A2 到 I 列最后一行有值的单元格 来锁定范围（我想做的是想把数据剔出来，进行复制粘贴），不知道我表达清楚没有。

lsc900707

1. Sub gj23w98()
   
2.     arr = Sheet2.UsedRange
   
3.     ReDim brr(1 To UBound(arr), 1 To 9)
   
4.     For i = 6 To UBound(arr)
   
5.         If arr(i, 6) > 0 And Len(arr(i, 7)) Then
   
6.             m = m + 1
   
7.             For j = 1 To 9
   
8.                 brr(m, j) = arr(i, j + 1)
   
9.             Next
   
10.         End If
    
11.     Next
    
12.     If m > 0 Then
    
13.         [a1].CurrentRegion.Offset(1).ClearContents
    
14.         [a2].Resize(m, 9) = brr
    
15.     End If
    
16. End Sub

复制代码

lsc900707

代码需要审核，附件供测试：

lnvi

lsc900707 发表于 2018-6-8 08:44
代码需要审核，附件供测试：

亲，转过来的数据能去掉C列吗？

lsc900707

lnvi 发表于 2018-8-22 15:03
亲，转过来的数据能去掉C列吗？

当然可以呀，你的结果要去掉这一列？

1. Sub gj23w98()
   
2.     arr = Sheet2.UsedRange
   
3.     ReDim brr(1 To UBound(arr), 1 To 8)
   
4.     For i = 6 To UBound(arr)
   
5.         If arr(i, 6) > 0 And Len(arr(i, 7)) Then
   
6.             m = m + 1
   
7.             brr(m, 1) = arr(i, 2)
   
8.             brr(m, 2) = arr(i, 3)
   
9.             For j = 3 To 8
   
10.                 brr(m, j) = arr(i, j + 2)
    
11.             Next
    
12.         End If
    
13.     Next
    
14.     If m > 0 Then
    
15.         [a1].CurrentRegion.Offset(1).ClearContents
    
16.         [a2].Resize(m, 8) = brr
    
17.     End If
    
18. End Sub

复制代码

lsc900707

lnvi 发表于 2018-8-22 15:03
亲，转过来的数据能去掉C列吗？

代码需要审核，先参考附件吧：