Building a new spreadsheet using information from another [Solved/Closed]

Report
Posts
3
Registration date
Tuesday December 13, 2016
Status
Member
Last seen
December 13, 2016
-
Posts
3
Registration date
Tuesday December 13, 2016
Status
Member
Last seen
December 13, 2016
-
Hello everyone,
I'm new to the forum and VBA and would like to thank you in advance for your assistance.

I have received a spreadsheet that contains several hundred rows and 30 columns. I need to copy this information in a new spreadsheet with a new layout. An example will best explain the current format and the new format needed. Any help would be greatly appreciated.
Example:
Original spreadsheet
Item Location 01/01/2017 01/08/2017 01/15/2017 01/22/2017 01/29/2016
123 xyz 10000 0 100000 45000 35000
124 abc 0 25000 35000 35000 25000

New spreadsheet
Location item qty date
xyz 123 10000 01/01/2017
xyz 123 0 01/08/2017
xyz 123 100000 01/15/2017
xyz 123 45000 01/22/2017
xyz 123 35000 01/29/2017
abc 124 0 01/01/2017
abc 124 25000 01/08/2017
abc 124 35000 01/15/2017
abc 124 35000 01/22/2017
abc 124 25000 01/29/2017


Thank's again for your time and assistance.

2 replies

Posts
11483
Registration date
Sunday June 8, 2008
Status
Contributor
Last seen
July 6, 2020
4
Can we assume that the new sheet is located in the same workbook as the original sheet, and initially empty (except for the first line) ?
Posts
3
Registration date
Tuesday December 13, 2016
Status
Member
Last seen
December 13, 2016

Yes, that is a safe assumption.
Thanks
Posts
11483
Registration date
Sunday June 8, 2008
Status
Contributor
Last seen
July 6, 2020
4
Proposal :
Option Explicit
Sub wtmayoza()
Dim wbo As Worksheet, wbn As Worksheet
Dim lastcol As Long 'last colum to handle in original sheet
Dim i As Long
Dim origline As Long, newline As Long
Set wbo = ThisWorkbook.Sheets("orig")
Set wbn = ThisWorkbook.Sheets("new")
origline = 2
newline = 2
lastcol = 2
Do While wbo.Cells(1, lastcol + 1) <> ""
    lastcol = lastcol + 1
Loop 'Do While wbo.Cells(1, totcol + 1) <> ""
Do While wbo.Cells(origline, 1) <> ""
    For i = 3 To lastcol
        wbn.Cells(newline, 1) = wbo.Cells(origline, 2)
        wbn.Cells(newline, 2) = wbo.Cells(origline, 1)
        wbn.Cells(newline, 3) = wbo.Cells(origline, i)
        wbn.Cells(newline, 4) = wbo.Cells(1, i)
        newline = newline + 1
    Next i
    origline = origline + 1
Loop 'Do While wbo.Cells(origline, 1) <> ""
End Sub
Posts
3
Registration date
Tuesday December 13, 2016
Status
Member
Last seen
December 13, 2016

You are so good! Thank you for your help.