如何在每个组之后插入一行基于上面的行

Question

请参阅下面的示例表，该表类似于我在Excel中使用的实际表格 - 希望这足以说明我的问题。使用VBA，我想基于第1列中的每个不同单元格添加一个新行（即，对于每个值的更改，插入一个新行），然后使用上面一行中的值填充该新行，并进行一些修改那一行（见第4,10-13栏）。

提前致谢！

Answer 1

根据您对我的第一个回答的评论，这是更新的代码。此代码适用于预先选定的范围，并要求您输入要应用代码的第4列值。

Sub codeForMike()

Dim rowX As Integer
Dim rangeSize As Integer
Dim col4 As Integer

col4 = InputBox("Insert rows where column 4 =", "Enter Number:")

rangeSize = Selection.Rows.Count
Selection.Cells(1).Select

rowX = ActiveCell.Row
rangeSize = rowX + rangeSize

Do
If Cells(rowX, 4).Value <> col4 Then
    rowX = rowX + 1

Else
    Range(Cells(rowX + 1, 1), Cells(rowX + 1, 13)).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Cells(rowX + 1, 1).Value = Cells(rowX, 1).Value
    Cells(rowX + 1, 2).Value = Cells(rowX, 2).Value
    Cells(rowX + 1, 3).Value = Cells(rowX, 3).Value
    Cells(rowX + 1, 6).Value = Cells(rowX, 6).Value
    Cells(rowX + 1, 7).Value = Cells(rowX, 7).Value
    Cells(rowX + 1, 8).Value = Cells(rowX, 8).Value
    Cells(rowX + 1, 9).Value = Cells(rowX, 9).Value
    Cells(rowX + 1, 10).Value = "0"
    Cells(rowX + 1, 11).Value = "0"
    Cells(rowX + 1, 12).Value = "0"
    Cells(rowX + 1, 13).Value = "0"

    rowX = rowX + 2
    rangeSize = rangeSize + 1
End If

Loop Until rowX = rangeSize



Range(Cells(rowX - 2, 1), Cells(rowX - 2, 13)).Copy
Cells(rowX - 1, 1).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

End Sub