Row Shift, Copy, Paste question?

[dubmartian]

Hi all, I have searched and found pieces of parts but I really need your help.
Here is my task.

1. I have (x) number of rows with various text in a single column
1.5 I would like to copy the text in each row.
2. I would like to take each row, insert x number of rows beneath that and paste that text in the empty rows
3. and do this for the total amount of rows that were initially populated with text.

(Initial Text) Row 1 xxxxxx
Row 2 yyyyyy
Row 3 zzzzzzz

(Number of new rows input = 4)

(New Text) Row 1 xxxxxx
Row 2 xxxxxx
Row 3 xxxxxx
Row 4 xxxxxx
Row 5 yyyyyy
Row 6 yyyyyy
Row 7 yyyyyy
Row 8 yyyyyy
Row 9 zzzzzz
Row 10 zzzzzz
Row 11 zzzzzz
Row 12 zzzzzz

The number of rows should be inserted based on input and I have seen this VBA but not the copy paste and loop field.

If someone can help me with this it will be a life saver and I am forever grateful. I have no real VBA experience which is why I am asking for help.

DBM Thanks everyone

 

[dubmartian]

The only time I get a type mismatch is if there are blank cells. Are there?

Mark, I think the problem is that in my text there is already an "_" character. I made a dummy file of text without the underscore and the code worked as fine as can be.

 

[dubmartian]

Mt text format will always be xxxx_xxxxx_01, is there a way to adjust the code to work with an existing "_" ?
Thanks

 

[MARK858]

Not in yet but post about 5 lines of your data as it is before any code is ran on it.

 

[dubmartian]

Not in yet but post about 5 lines of your data as it is before any code is ran on it.

[TABLE="width: 211"]
<tbody>[TR]
[TD]Allen_Bradley_1503VCBMC5[/TD]
[/TR]
[TR]
[TD]Allen_Bradley_150A05NA[/TD]
[/TR]
[TR]
[TD]Allen_Bradley_150A05NB[/TD]
[/TR]
[TR]
[TD]Allen_Bradley_150A05NBB22ND[/TD]
[/TR]
[TR]
[TD]Allen_Bradley_150A05NBD1ND[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]

 

[My Aswer Is This]

I Think I made a mistake.

Try this:

Sub Fill_Me_Down_New()
Application.ScreenUpdating = False
Dim i As Long
Dim b As Long
Dim Lastrow As Long
Dim Lastrowa As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Dim x As Long
x = 1
    For i = Lastrow To 1 Step -1
        Cells(i, 1).Resize(4).FillDown
            If i > 1 Then Cells(i, 1).Resize(3).Insert xlDown
    Next
    Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    For b = 1 To Lastrow
        If x > 4 Then x = 1
        Cells(b, 1).Value = Cells(b, 1).Value & "_0" & x
        x = x + 1
    Next
    
Application.ScreenUpdating = True
End Sub

 

[dubmartian]

That worked indeed.
Thank you all so much for helping. Im going to read up and break down the code and syntax so I have a better understanding of what's going on.
Again, I appreciate the help.

Awesome!!!!!

 

[My Aswer Is This]

Glad I was able to help you. Come back here to Mr. Excel next time you need additional assistance.

That worked indeed.
Thank you all so much for helping. Im going to read up and break down the code and syntax so I have a better understanding of what's going on.
Again, I appreciate the help.

Awesome!!!!!