Previous Topic Next Topic

Building a new spreadsheet using information from another

Solved/Closed
wtmayoza Posts 3 Registration date Tuesday December 13, 2016 Status Member Last seen December 13, 2016 - Dec 13, 2016 at 12:30 PM
wtmayoza Posts 3 Registration date Tuesday December 13, 2016 Status Member Last seen December 13, 2016 - Dec 13, 2016 at 05:48 PM
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.
Related:

2 responses

Answer 1 / 2
yg_be Posts 23541 Registration date Sunday June 8, 2008 Status Contributor Last seen June 6, 2025 5
Dec 13, 2016 at 03:37 PM
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) ?
wtmayoza Posts 3 Registration date Tuesday December 13, 2016 Status Member Last seen December 13, 2016
Dec 13, 2016 at 05:40 PM
Yes, that is a safe assumption.
Thanks
Answer 2 / 2
yg_be Posts 23541 Registration date Sunday June 8, 2008 Status Contributor Last seen June 6, 2025 5
Dec 13, 2016 at 03:51 PM
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
wtmayoza Posts 3 Registration date Tuesday December 13, 2016 Status Member Last seen December 13, 2016
Dec 13, 2016 at 05:48 PM
You are so good! Thank you for your help.