Working with Macros

[odin13]

I am working from an original file that has four-five columns of product IDs, these original columns must be reformatted into one column with four-five rows for each individual listing. This is a fairly large worksheet and would be far more tedious than I would like to copy and paste each entry, so if there are any suggestions for how to speed up this process that would be great.

Attachment one is the original file. Attachment two is the altered file which has been started to get an example of what I am trying to do.

[Andy Pope]

Your post does not comply with Rule 1 of our Forum RULES. Your post title should accurately and concisely describe your problem, not your anticipated solution. Use terms appropriate to a Google search. Poor thread titles, like Please Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will be addressed according to the OP's experience in the forum: If you have less than 10 posts, expect (and respond to) a request to change your thread title. If you have 10 or more posts, expect your post to be locked, so you can start a new thread with an appropriate title.
To change a Title on your post, click EDIT then Go Advanced and change your title, if 2 days have passed ask a moderator to do it for you.

Sub x()

    Dim rngData As Range
    Dim rngRecord As Range
    Dim rngID As Range
    Dim shtOutput As Worksheet
    Dim lngOutRow As Long
    Dim lngCol As Long
    
    Set rngData = ActiveSheet.UsedRange
    Set rngData = rngData.Offset(1, 0).Resize(rngData.Rows.Count - 1)
    
    Set shtOutput = ActiveWorkbook.Worksheets.Add
    Application.ScreenUpdating = False
    
    shtOutput.Range("A1:J1") = Array("productID", "ProductName", "nDieselModelID", "sSensor", "sEngine", "ENGINE", "sHp", "sHPRating", "sModel", "sModelName")
    
    lngOutRow = 2
    For Each rngRecord In rngData.Rows
        For Each rngID In rngRecord.Range("A1", "E1")
            If Len(rngID.Value) > 0 Then
                shtOutput.Cells(lngOutRow, 1) = rngID
                rngRecord.Range("F1:N1").Copy shtOutput.Cells(lngOutRow, 2)
                lngOutRow = lngOutRow + 1
            End If
        Next
    Next
    Application.ScreenUpdating = True
    
End Sub