按要求提取内容到指定区域

天地一相

感谢帮助！详见截图附件。

liulang0808

Public x As Integer

Sub test()
    r = Sheets(2).Cells(Rows.Count, 2).End(3).Row
    If x >= r Then Exit Sub
    Application.ScreenUpdating = False
    If x = 0 Then x = 1
    x = x + 1
    arr = Array("b", "e", "j", "k", "l")
    For Each i In arr
        Sheets(2).Cells(x, i).Copy
        Range(i & "3:" & i & 10000).Select
        ActiveSheet.Paste
    Next
    Application.ScreenUpdating = True
End Sub

天地一相

liulang0808 发表于 2023-2-9 08:36
Public x As Integer

Sub test()

谢谢，在你代码的基础上，我修改成这样了，更快。原本想着精准定位少处理点单元格会快，测试发现比较慢。就修改成整片粘贴了。去掉了判断语句，因为点击次数受宏循环次数严格限制的。

剑指E

天地一相

liulang0808 发表于 2023-2-9 08:36
Public x As Integer

Sub test()

先谢，今天仔细测试，还是你的速度快。我模仿写的不行。现在出现一个问题。写入的位置列号与提取时的列号不相同怎么办？

liulang0808

天地一相 发表于 2023-2-10 18:05
先谢，今天仔细测试，还是你的速度快。我模仿写的不行。现在出现一个问题。写入的位置列号与提取时的列号 ...

arr数组里的列号对应调整下，看看是否可行

天地一相

liulang0808 发表于 2023-2-10 18:56
arr数组里的列号对应调整下，看看是否可行

谢谢。我的意思是，shee2的B,E,J ,copy过来写入的是，C,F,M,。

liulang0808

天地一相 发表于 2023-2-10 19:45
谢谢。我的意思是，shee2的B,E,J ,copy过来写入的是，C,F,M,。

那就提交一个附件，对应着附件内容说明吧

天地一相

liulang0808 发表于 2023-2-10 20:03
那就提交一个附件，对应着附件内容说明吧

谢谢。请看附件。

liulang0808

天地一相 发表于 2023-2-10 20:10
谢谢。请看附件。

不好意思，附件内容没有看懂，