Adding lines based on cell value

[rubinda]

I have a file that I am trying to copy specific cells down based on the number in column E.

If a cell in column E>1, I want to copy the following cells in a column down that many lines (for example: if the number in column E is 4, I will need 3 additional lines copied/pasted below, for a total of 4 lines). CELLS IN A COLUMN THAT NEED TO BE COPIED (A, B, F, G and H).

If a cell in column E=1, I want nothing to happen.

This is advanced for my experience in coding. Any help is appreciated.

 

[Nine Zero]

Try this out

Sub ColumnE()
Dim r As Range
Dim rrow As Integer
'change the line below to the size of your data 
For Each r In Range("E1:E15")
    If r.Value > 1 Then
        rrow = r.Row
        Rows((rrow + 1) & ":" & (rrow + r.Value - 1)).Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Range("A" & rrow & ":B" & rrow).Select
        Selection.AutoFill Destination:=Range("A" & rrow & ":B" & rrow + r.Value - 1), Type:=xlFillCopy
        Range("A" & rrow & ":B" & rrow).Select
        Range("F" & rrow & ":H" & rrow).Select
        Selection.AutoFill Destination:=Range("F" & rrow & ":H" & rrow + r.Value - 1), Type:=xlFillCopy
    End If
Next r
End Sub

 

[rubinda]

I get a run type error 13, type mismatch error that points to: Rows((rrow + 1) & ":" & (rrow + r.Value - 1)).Select

 

[Nine Zero]

that is so weird.... i just tried it again and it worked fine....

im honestly out of ideas on this .. hopefully someone else can chime in

 

[rubinda]

I had to change the range in column E and now it works. Thank you.

The only thing I need to change is that it deletes the data in column C. How do I prevent that from happening?

 

[rubinda]

Even better, how would I include column C as one of the copied/pasted cells?

 

[Nine Zero]

Sorry for the late reply ... change the B to a C to include column C I highlighted it in red

Sub ColumnE()
Dim r As Range
Dim rrow As Integer
'change the line below to the size of your data 
For Each r In Range("E1:E15")
    If r.Value > 1 Then
        rrow = r.Row
        Rows((rrow + 1) & ":" & (rrow + r.Value - 1)).Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Range("A" & rrow & ":[COLOR=#ff0000]C[/COLOR]" & rrow).Select
        Selection.AutoFill Destination:=Range("A" & rrow & ":[COLOR=#ff0000]C[/COLOR]" & rrow + r.Value - 1), Type:=xlFillCopy
        Range("A" & rrow & ":[COLOR=#ff0000]C[/COLOR]" & rrow).Select
        Range("F" & rrow & ":H" & rrow).Select
        Selection.AutoFill Destination:=Range("F" & rrow & ":H" & rrow + r.Value - 1), Type:=xlFillCopy
    End If
Next r
End Sub

[/QUOTE]