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
