|
发表于 2012-11-23 21:48
|
显示全部楼层
本楼为最佳答案
本帖最后由 hwc2ycy 于 2012-11-23 21:51 编辑
- Sub 插行2()
- Dim rg As Range
- Dim StartRow&, EndRow&, InsertRow&, i&, msg$, Result
- On Error Resume Next
- Do
- Set rg = Application.InputBox("请选择要复制的区域:", , , , , , , 8)
- If rg Is Nothing Then Exit Sub
- StartRow = rg.Row
- EndRow = rg.Rows.Count + StartRow - 1
- InsertRow = Application.InputBox("请输入要复制的行数", , , , , , , 1)
- If InsertRow < =0 Then Exit Sub
- msg = "要复制的区域为:" & rg.Address(False, False) & vbCr & "要复制的行数为:" & InsertRow
- Result = MsgBox(msg, vbOKCancel + vbApplicationModal, "确认!")
- Loop While Result = 2
-
- Application.ScreenUpdating = False
- For i = EndRow + 1 To StartRow - 1 Step -1
- Rows(i - 1).Copy
- Rows(i).Resize(InsertRow).Insert
- Next
- Application.CutCopyMode = False
- Application.ScreenUpdating = True
- End Sub
复制代码 改进版,可自由选择区域,及要复制的行数。 |
|