Excel vba - 为活动单元格插入新行答案

【问题标题】：Excel vba - insert new row for active cellsExcel vba - 为活动单元格插入新行
【发布时间】：2017-09-21 14:14:09
【问题描述】：

我在单元格下方插入新行时遇到问题。我需要在每个活动单元格下方插入新行。使用此代码 Excel 将崩溃。感谢帮助

Sub CopyRow()

    Dim cel As Range
    Dim selectedRange As Range

    Set selectedRange = Application.Selection

    For Each cel In selectedRange.Cells
        cel.Offset(1, 0).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
        'copy data
         cel.Offset(1, 0 ).Value = cel.Value
    Next cel

End Sub

【问题讨论】：

Try cel.Offset(1, 0).EntireRow.Insert 这会让你摆脱遇到的错误，但你会遇到一个新问题，其中新插入的行现在是所选范围的一部分，所以你的下一次迭代是到插入新行的新行，你最终陷入无限循环。您可能需要一个循环，从所选范围内的最后一个单元格开始，然后向后 (step -1) 在迭代后面插入行。

标签： excel vba

【解决方案1】：

这会拍摄所选范围的快照，然后在 UsedRange 上向后工作：

Option Explicit

Public Sub CopyRows()
    Dim sRng As Range, sRow As Long, sr As Variant
    Dim r As Long, lb As Long, ub As Long

    Set sRng = Application.Selection
    sRow = sRng.Row
    If sRng.CountLarge = 1 Then
        With ActiveSheet.UsedRange
            .Rows(sRow + 1).EntireRow.Insert Shift:=xlShiftDown
            .Rows(sRow + 1).Value2 = .Rows(sRow).Value2
        End With
    Else
        sr = sRng
        lb = LBound(sr)
        ub = UBound(sr)
        Application.ScreenUpdating = False
        With ActiveSheet.UsedRange
            For r = ub To lb Step -1
                .Rows(r + sRow).EntireRow.Insert Shift:=xlShiftDown
                .Rows(r + sRow).Value2 = .Rows(r + sRow - 1).Value2
            Next
            .Rows(lb + sRow - 1 & ":" & ub * 2 + sRow - 1).Select
        End With
        Application.ScreenUpdating = True
    End If
End Sub

【讨论】：