Excel Code to duplicate rows based on multiple values and columns

Question

i have list of products with sales numbers for each month. i want to create new table which duplicate the values based on month and to write the month in additional column.

This is the table

and this is the result i want

Thank you

Answer 1

Please, try the next code:

Sub testTransposePerMonth()
 Dim sh As Worksheet, sh1 As Worksheet, lastR As Long, arr, arrF
 Dim i As Long, k As Long, j As Long, n As Long, maxF As Long

 Set sh = ActiveSheet
 Set sh1 = sh.Next 'use here the sheet you need
 
 lastR = sh.Range("A" & rows.count).End(xlUp).row 'last row of the existing sheet
 arr = sh.Range("A1:O" & lastR).Value             'put the range in an array
 maxF = WorksheetFunction.Sum(sh.Range("D2:O" & lastR)) + 1 'calculate the arrF rows No

 ReDim arrF(1 To maxF, 1 To 4)                    'Redim the final array
 arrF(1, 1) = "Product Number": arrF(1, 2) = "City"
 arrF(1, 3) = "Region": arrF(1, 4) = "Month"      'Put headers in the array
 k = 2
 For i = 2 To UBound(arr)       'iterate between all the array elements
    For j = 4 To UBound(arr, 2) 'iterate between the array cols, starting from the fourth
        If arr(i, j) <> "" Then 'if it is a value on the row
            For n = 1 To CLng(arr(i, j)) 'add so many rows as the number means
                arrF(k, 1) = arr(i, 1): arrF(k, 2) = arr(i, 2)
                arrF(k, 3) = arr(i, 3): arrF(k, 4) = arr(1, j): k = k + 1 'iterate k
            Next
        End If
    Next j
 Next i
 'drop the processed array at once:
 sh1.Range("A1").Resize(UBound(arrF), 4).Value = arrF
End Sub