Sub自定义复制行()

'任意次数的复制行,根据B列中的数值（要求大于1的）来复制行

'声明一个range对象变量mycell

Dim mycell As Range

'将Sheet1的B2赋值给mycell

Set mycell = Sheets("Sheet1").Range("B2")

'开始Do循环，直到单元格为空

Do While Not IsEmpty(mycell)

'如果mycell的值大于1

If mycell > 1 Then

'在当前单元格下面一行插入整行，插入的行数为当前单元格值-1，即如果单元格值为2，则插入1行

Range(mycell.Offset(1, 0),mycell.Offset(mycell.Value - 1, 0)).EntireRow.Insert

'复制mycell单元格所在行的值，并向下填充

'.filldown指从指定区域的顶部单元格开始向下填充，直至该区域的底部。区域中首行单元格的内容和格式将复制到区域中其他行内。

Range(mycell, mycell.Offset(mycell.Value -1, 1)).EntireRow.FillDown

End If

'mycell 向下移动 mycell.value( 即 mycell 单元格值）行，将此单元格重新赋值给 mycell ， ‘ 即如果 mycell 是 B2 ，单元格值是 2 ，会插入 1 行，之前的 B3 会被挪到 B4 ，因此需要把 B4 单元格赋值给 mycell ，即 B2 向下移动的行数是 B2 的值

Set mycell = mycell.Offset(mycell.Value, 0)

Loop

End Sub