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

说我有这样的数据

ABC 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的公式。

所以,结果会是这样的

  ABC 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 

问题是我必须粘贴数百次,这将是非常耗时的。

如果有人能帮忙,我将不胜感激。

请记住:

  • 您需要确保您在A1栏中有一个值,否则只需将数值增加到第二行。

  • Var是一个虚拟variables,用于在发生新名称时跟踪。

  • 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 
 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中使用相对引用。