Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 921|回复: 7

[已解决]如何将复制的数据在已有的每一行数据中循环插入

[复制链接]
发表于 2022-5-16 19:28 | 显示全部楼层 |阅读模式
本帖最后由 nagimagi 于 2022-5-16 21:32 编辑

要求如下
1. sheet1中,复制1-3列
QQ图片20220516192723.png
2. 粘贴已复制的数据行到sheet2下,
QQ图片20220516192729.png
3. 想达到的效果是,把sheet1中复制的数据行,粘贴到sheet2中每一个有数据的行的下面,比如这样,如此循环往复
QQ图片20220516192733.png



刚接触vba小白一个,用过循环for to next, 但不知怎么在语句设置参数,
求助这里的各路大神指点一下迷津!谢谢大家!!









最佳答案
2022-5-17 08:14
請測試看看,謝謝
发表于 2022-5-16 19:55 | 显示全部楼层
本帖最后由 楚雪飞扬 于 2022-5-16 19:59 编辑

看下是否,是你需要的结果
Sub Test()
    Sheets("Sheet1").Activate
    Range("A1").CurrentRegion.Offset(0).Resize(Range("A1").CurrentRegion.Rows.Count).Select
    Selection.Copy
    Sheets("Sheet2").Activate
    Range("A65536").End(3).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

Book1.zip

14.11 KB, 下载次数: 4

回复

使用道具 举报

 楼主| 发表于 2022-5-16 21:31 | 显示全部楼层
本帖最后由 nagimagi 于 2022-5-16 21:35 编辑
楚雪飞扬 发表于 2022-5-16 19:55
看下是否,是你需要的结果
Sub Test()
    Sheets("Sheet1").Activate

谢谢大佬的回复,学到姿势了,但是,不太符合需求。
1. 首先,举例中的sheet1,其实选择的行并不一定是从首行开始的,所以不能使用Rows.Count,不太符合我的需求
2. 其次,是需要在sheet2中已有数据的基础上,插入复制的单元格,而并不是在最后一行单纯append
我是这样选择的,但即便换成我的选择方式,第二步的粘贴也没法实现

'选择sheet1的1-3行并复制
Sheets("Sheet1").Rows("1:3").Select
Application.CutCopyMode = True
Selection.Copy
’粘贴到sheet2
Application.Goto Sheets("Sheet1").Rows("2:2")
Selection.Insert Shift:=xlDown

然后问题是如何将上诉操作循环。。。我的思路是这样的,尝试过后报错了

Sub_test()
Dim i As Integer, n As Integer
'选择sheet1的1-3行并复制
Sheets("Sheet1").Rows("1:3").Select
Application.CutCopyMode = True
Selection.Copy
' 假设sheet2有26行,从第2行开始粘贴
n=2
For i = 1 To 26 step 1
Rows("n:n").Select
Rows("n:n").Select = Rows("n+4":"n+4")  ' 因为包括原来数据的一行,所以是向下偏移4行
Next
End Sub

回复

使用道具 举报

发表于 2022-5-17 08:14 | 显示全部楼层    本楼为最佳答案   
請測試看看,謝謝

Book1_0517.zip

15.64 KB, 下载次数: 3

回复

使用道具 举报

 楼主| 发表于 2022-5-17 10:24 | 显示全部楼层
sam-wang 发表于 2022-5-17 08:14
請測試看看,謝謝

成功了!非常感谢!!
大佬的代码太厉害了,我研究下看能不能用到实际业务上!![比心]
回复

使用道具 举报

 楼主| 发表于 2022-5-17 12:10 | 显示全部楼层
sam-wang 发表于 2022-5-17 08:14
請測試看看,謝謝

你好,大佬,仔细看了下,发现结果不太对,因为变成了复制sheet1的第一行,并重复粘贴三遍到sheet2的每一行下面去了,sheet1的第2、3行没有复制到
结果是这样的
QQ图片20220517120931.png QQ图片20220517120935.png



回复

使用道具 举报

发表于 2022-5-17 13:08 | 显示全部楼层
nagimagi 发表于 2022-5-17 12:10
你好,大佬,仔细看了下,发现结果不太对,因为变成了复制sheet1的第一行,并重复粘贴三遍到sheet2的每一 ...


不好意思,已更新,請再確認,謝謝

Sub Test()
Dim Arr, Brr, Crr(1 To 100000, 1 To 3)
Dim n&, n1&, i&, j%, x%, x1%
Arr = Sheets(1).[a1].CurrentRegion
Brr = Sheets(2).[a1].CurrentRegion
For i = 1 To UBound(Brr)
    If Brr(i, 1) <> "" Then
        If n1 < 1 Then n = n + 1 Else n = n1 + 1
        For j = 1 To 3: Crr(n, j) = Brr(i, j): Next
        n1 = n + UBound(Arr)
        For x = n + 1 To n1
            x1 = x1 + 1
            For j = 1 To 3
                Crr(x, j) = Arr(x1, j)
            Next j
        Next
        x1 = 0
    End If
Next
Sheets(2).[a1].Resize(n1, 3) = Crr
End Sub


1.JPG
回复

使用道具 举报

 楼主| 发表于 2022-5-17 15:57 | 显示全部楼层
sam-wang 发表于 2022-5-17 13:08
不好意思,已更新,請再確認,謝謝

Sub Test()

感谢大佬!!根据自己的业务调试成功了,但由于只看懂一部分,没有完全玩得转。

总之非常感谢!!
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 07:12 , Processed in 0.738731 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表