Macro to duplicate rows based on cell value in another worksheet

[Flipmodes]

Sorry - i've been looking all morning and can't seem to find what I'm looking for. I stick with code also, so hopefully some of you smart folks can help...

Here's the need (I figured a graphic would do more justice than me trying to explain):

 

[MickG]

Try this:-
Results start "D1"

[COLOR="Navy"]Sub[/COLOR] MG15Apr25
[COLOR="Navy"]Dim[/COLOR] Rng1 [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Rng2 [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
c = 1
[COLOR="Navy"]Set[/COLOR] Rng1 = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] Rng2 = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
Range("D1").Resize(Rng1.Count) = Rng1.Value
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng2
    [COLOR="Navy"]With[/COLOR] Range("E" & c)
        .Resize(Rng1.Count) = Dn
        .Offset(, 1).Resize(Rng1.Count) = Rng1.Value
    [COLOR="Navy"]End[/COLOR] With
        c = c + Rng1.Count
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[dave3009]

Something else to try

Sub create_list()
Dim lstV, lstC As Long
Dim i, j As Long
Dim currRow As Long




With Sheet1
    lstV = .Range("A" & Rows.Count).End(xlUp).Row
    lstC = .Range("B" & Rows.Count).End(xlUp).Row
End With


currRow = 2


For i = 2 To lstC
    For j = 2 To lstV
       Sheet2.Range("A" & currRow) = Sheet1.Range("B" & i)
       Sheet2.Range("B" & currRow) = Sheet1.Range("A" & j)
       
       currRow = currRow + 1
    Next j
Next i


End Sub

 

[Flipmodes]

MickG - your solution works perfectly thanks!
Dave - I tried yours also, no errors but nothing happens.

Thanks both for the quick replies.