Excel VBA- copy and insert row based on cell value

生来就可爱ヽ(ⅴ<●) 提交于 2019-12-23 05:14:20

问题


I'm trying to accomplish this:

column G ========> new column G

2                            1

                             2

2                            1

                             2

1                            1

1                            1

2                            1

                             2

I've looked at many different questions to answer this but I believe my code is incorrect because I want to copy the entire row when initially G = 2 and insert it directly beneath, instead of the usual copy it to another sheet in 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

Thank you so much to any and all help!!

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


回答1:


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


来源:https://stackoverflow.com/questions/31256265/excel-vba-copy-and-insert-row-based-on-cell-value

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!