Copy and paste Cells in Column based on Value in Cell

[matt121237]

I'm trying to copy items from column A multiple times based on count in B into another column. I've tried using an i variable to loop and finding the next open cell but my jumble code that I've pieced together is worthless. I know that has to be super simple.

I've shown below the example items and counts in Column A and B and what the result would look like in column D. Can anyone point me in the right direction?

TEST COPY PASTE.xlsx
	A	B	C	D
1	ITEM	COUNT		RESULT
2	ABC	3		ABC
3	DEF	5		ABC
4	GHI	2		ABC
5	JKL	7		DEF
6				DEF
7				DEF
8				DEF
9				DEF
10				GHI
11				GHI
12				JKL
13				JKL
14				JKL
15				JKL
16				JKL
17				JKL
18				JKL
Sheet1

 

[kevin9999]

Perhaps...

Option Explicit
Sub matt121237()
    Application.ScreenUpdating = False
    Dim rng As Range, c As Range, lr As Long, qty As Long
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")
    lr = ws.Cells(Rows.Count, "D").End(xlUp).Row + 1
    Set rng = ws.Range("A2", ws.Cells(Rows.Count, "A").End(xlUp))
    
    For Each c In rng
        qty = c.Offset(, 1)
        ws.Cells(lr, 4).Resize(qty).Value2 = c
        lr = ws.Cells(Rows.Count, 4).End(3).Row + 1
    Next c
    
    Application.ScreenUpdating = True
End Sub

 

[matt121237]

Perhaps...

Option Explicit
Sub matt121237()
    Application.ScreenUpdating = False
    Dim rng As Range, c As Range, lr As Long, qty As Long
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")
    lr = ws.Cells(Rows.Count, "D").End(xlUp).Row + 1
    Set rng = ws.Range("A2", ws.Cells(Rows.Count, "A").End(xlUp))
   
    For Each c In rng
        qty = c.Offset(, 1)
        ws.Cells(lr, 4).Resize(qty).Value2 = c
        lr = ws.Cells(Rows.Count, 4).End(3).Row + 1
    Next c
   
    Application.ScreenUpdating = True
End Sub

I will try as soon as I get back tonight!!! Thanks so much, I can see right off where my issue was in a few spots!!! Thanks again for the quick response.

 

[kevin9999]

Thanks Matt. Slight amendment in case of empty cell:

For Each c In rng
        qty = c.Offset(, 1)
        If qty > 0 Then ws.Cells(lr, 4).Resize(qty).Value2 = c
        lr = ws.Cells(Rows.Count, 4).End(3).Row + 1
    Next c

 

[smozgur]

@matt121237 - I assume the question has been answered since you marked your post as the solution. However, that would be great if you could mark the post as the solution that answered your question in your future threads to help future readers. No further action is required for this question as I already switched the marked solution.

 

[matt121237]

@matt121237 - I assume the question has been answered since you marked your post as the solution. However, that would be great if you could mark the post as the solution that answered your question in your future threads to help future readers. No further action is required for this question as I already switched the marked solution

I hadn't had the chance to test yet and was waiting to do so before marking it. Appreciate your help though.

Thanks Matt. Slight amendment in case of empty cell:

For Each c In rng
        qty = c.Offset(, 1)
        If qty > 0 Then ws.Cells(lr, 4).Resize(qty).Value2 = c
        lr = ws.Cells(Rows.Count, 4).End(3).Row + 1
    Next c

Worked Flawlessly. Thanks Kevin.

 

[smozgur]

I hadn't had the chance to test yet and was waiting to do so before marking it. Appreciate your help though.

You have marked your own post (#3) as the solution, that's why I replied to let you know that I switched the marked post.

 

[kevin9999]

I hadn't had the chance to test yet and was waiting to do so before marking it. Appreciate your help though.


Worked Flawlessly. Thanks Kevin.

Glad to help Matt, and thanks for the feedback.