如何在Excel之间一次多次粘贴数据

时间:2012-11-16 05:57:54

标签: excel vba copy-paste

说我有这样的数据

  A   B   C
1 Jim 1 10    
2 Jim 2 20
3 Jim 3 30
4 Tom 1 20
5 
6 
7 Jos 1 15
8
9

我想要的是复制第2行和第3行,然后粘贴到第5行和第6行,然后粘贴到第8行和第9行,依此类推。空行总是2。

单元格2C和3C中有一个公式计算B列中的值乘以单元格C1。

所以,结果就像这样

  A   B   C
1 Jim 1 10    
2 Jim 2 20
3 Jim 3 30
4 Tom 1 20
5 Tom 2 40 
6 Tom 3 60
7 Jos 1 15
8 Jos 2 30
9 Jos 3 45

问题是我必须粘贴数百次才会耗费时间。

如果有人可以提供帮助,我将不胜感激。

2 个答案:

答案 0 :(得分:0)

Sub MakeRows()
    Dim Sh As Worksheet, DataRng As Range, CopyRng As Range, TargetRng As Range

    Set Sh = Sheets(1) 'select your sheet here
                       'you can also do it like this = Worksheets("name")

    Set DataRng = Sh.Range("B2")
    Set TargetRng = Sh.Range("A4")

    While IsEmpty(TargetRng) = False
       TargetRng.Copy TargetRng.Offset(1, 0)
       TargetRng.Copy TargetRng.Offset(2, 0)

       Set CopyRng = Sh.Range(DataRng, DataRng.Offset(1, 1))
       CopyRng.Copy TargetRng.Offset(1, 1)

       Set TargetRng = TargetRng.Offset(3, 0)
       Set DataRng = DataRng.Offset(3, 0)
    Wend
End Sub

使用单元格2C和3C中的相对引用。

答案 1 :(得分:0)

请记住:

  • 您需要确保在A1列中有值,否则 只需使用数据将i的值增加到第二行。

  • Var是一个虚拟变量,用于在新名称出现时跟踪。

  • firstValue将包含每个名称第一行的rownumber。

<强>代码

Sub test()

Var = 0
LastRow = Cells(Rows.Count, "A").End(xlUp).Row + 2

For i = 2 To LastRow
    If Range("A" & i).Value = "" Then
        If Var = 0 Then
            firstValue = i - 1
            Range("A" & i).Value = Range("A" & i - 1).Value
            Range("B" & i).Value = Range("B" & i - 1).Value + 1
            Range("C" & i).Value = Range("C" & firstValue).Value + Range("C" & i - 1).Value
            Var = Var + 1
        Else
            Range("A" & i).Value = Range("A" & i - 1).Value
            Range("B" & i).Value = Range("B" & i - 1).Value + 1
            Range("C" & i).Value = Range("C" & firstValue).Value + Range("C" & i - 1).Value
            Var = Var + 1
        End If
    Else
        Var = 0
    End If
Next i

End Sub