Excel VBA-根据单元格值复制和插入行

时间:2015-07-06 21:50:28

标签: excel vba duplicates rows

我正在努力实现这个目标:

栏目G ========>新栏目G

2                            1

                             2

2                            1

                             2

1                            1

1                            1

2                            1

                             2

我已经看了许多不同的问题来回答这个问题,但我认为我的代码不正确,因为我想在最初G = 2时复制整行并将其直接插入下面,而不是通常将其复制到另一张表中Excel中。

Sub duplicate()
Dim LastRow As Long
Dim i As Integer
For i = 2 To LastRow
If Range("G" & i).Value = "2" Then
    Range(Cells(Target.Row, "G"), Cells(Target.Row, "G")).Copy
    Range(Cells(Target.Row, "G"), Cells(Target.Row, "G")).EntireRow.Insert    Shift:=xlDown
End If
Next i
End Sub

非常感谢你们所有的帮助!

Excel VBA automation - copy row "x" number of times based on cell value

1 个答案:

答案 0 :(得分:0)

Public Sub ExpandRecords()

    Dim i As Long, s As String
    Const COL = "G"

    For i = 1 To Cells(Rows.Count, COL).End(xlUp).Row
        If Cells(i, COL) = 2 Then
            s = s & "," & Cells(i, COL).Address
        End If
    Next
    If Len(s) Then
        Range(Mid$(s, 2)).EntireRow.Insert
        For i = 1 To Cells(Rows.Count, COL).End(xlUp).Row
            If Cells(i, COL) = vbNullString Then
                Cells(i, COL).Value = 1
            End If
        Next
    End If

End Sub