try:
Sub foo()
Dim lProd As Long, lCount As Long, lPic As Long, lRow As Long
Dim wsFrom As Worksheet, wsTo As Worksheet
Set wsFrom = Worksheets("Sheet1")
Set wsTo = Worksheets("Sheet2")
Application.ScreenUpdating = False
lRow = 2
For lProd = 2 To wsFrom.Range("A2").End(xlDown).Row
For lCount = 35 To 41
For lPic = 1 To wsFrom.Cells(lProd, 2).Value
wsTo.Cells(lRow, 1).Value = wsFrom.Cells(lProd, 1).Value & "-" & lCount
wsTo.Cells(lRow, 2).Value = Replace(wsFrom.Cells(lProd, 3).Value, ".jpg", lPic & ".jpg")
lRow = lRow + 1
Next lPic
Next lCount
Next lProd
Application.ScreenUpdating = True
End Sub
Bookmarks