Report

Building a new spreadsheet using information from another [Solved]

Ask a question wtmayoza 3Posts Tuesday December 13, 2016Registration date December 13, 2016 Last seen - Last answered on Dec 13, 2016 at 05:48 PM by wtmayoza
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.
Helpful
+0
plus moins
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 3Posts Tuesday December 13, 2016Registration date December 13, 2016 Last seen - Dec 13, 2016 at 05:40 PM
Yes, that is a safe assumption.
Thanks
Reply
Leave a comment
Helpful
+0
plus moins
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 3Posts Tuesday December 13, 2016Registration date December 13, 2016 Last seen - Dec 13, 2016 at 05:48 PM
You are so good! Thank you for your help.
Reply
Leave a comment

Member requests are more likely to be responded to.

Members can monitor the statuses of their requests from their account pages.

A CCM membership gives you access to additional options.

Not a member yet?

Sign up now. It takes less than a minute and is completely free!