如何在数据之间一次在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中使用相对引用。