当单元格具有单元格范围内的值时插入新行

Question

当一个单元格在一个单元格区域内有一个值时，我需要一个宏来复制并在现有的下面插入一行，下面的宏插入一个没有应对单元格值的空白行，

更具体地说，我需要在一个范围副本中填写一个单元格并在其下面插入一个特定的行，并使用这个新的单元格值

Sub new-macro()
    Dim rng As Range
    Dim cell As Range

    Set rng = Range("F2:F12")

    For Each cell In rng
        If Not IsEmpty(cell.Value) Then
            ActiveCell.Offset(1, 0).Select
            ActiveCell.EntireRow.Insert
            ActiveCell.Offset(1, 0).Select
        Else
            ActiveCell.Offset(1, 0).Select
        End If
    Next
End Sub

---

我找到了这个脚本，但它给了我“下标超出范围”，任何想法为什么PLZ？

Sub insertRowFormatFromAbove() 

Worksheets("Insert row").Rows(27).Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromLeftOrAbove 

End Sub

Answer 1

要在F2：F12范围内更改值时添加（复制和插入）特定行，必须使用Worksheet_Change事件。

您可能必须将Rows(1).Copy调整为要复制的行号。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("F2:F12")) Is Nothing Then 'if changed cell is within the range
        If Not IsEmpty(Target) Then
            Rows(1).Copy 'copy row number 1
            Application.EnableEvents = False 'prevent the following line to trigger the change event again
            Target.Offset(RowOffset:=1).EntireRow.Insert Shift:=xlShiftDown 'insert copied row
            Application.EnableEvents = True 're enable events
        End If
    End If
End Sub

• 我建议你阅读How to avoid using Select in Excel VBA。使用Select是一种不好的做法，使你的代码变慢，所以强烈建议避免使用它。