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
15962
Registration date
Sunday June 8, 2008
Status
Contributor
Last seen
June 9, 2021
5
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
15962
Registration date
Sunday June 8, 2008
Status
Contributor
Last seen
June 9, 2021
5
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.

Subscribe To Our Newsletter!

The Best of CCM in Your Inbox

Subscribe To Our Newsletter!