How can I use Excel VBA to copy cells from one sheet to another and transposing data to a list

Posted on 2014-08-17
Last Modified: 2014-08-17
I'm tryin to figure out how to copy selected cells from one sheet to another and at the sametime transposing the data structure.

I would like to transpose from this:
to this:
Sofar I'm working on a makro e.g this:
Sub copy()
    Dim strSeek As String
    Dim strSeekWeek As String
    Const strSourceSheet As String = "RawData"
    Const strDestSheet As String = "Data"
    Dim r As Integer
    Dim found As Integer
    Dim rng As Range
    Dim c As Object
    Dim lrow As Integer
    Dim SletData As Range
    Dim i As Integer

    'select data
    Range("A1", Range("A" & Rows.Count).End(xlUp)).Select
    Set rng = Selection
    'copy    For Each c In rng

        Sheets(strDestSheet).Range("A1").Offset(r, 0).Value = c.Offset(0, 0).Value
        Sheets(strDestSheet).Range("A1").Offset(r, 1).Value = c.Offset(0, 1).Value
        Sheets(strDestSheet).Range("A1").Offset(r, 2).Value = c.Offset(0, 2).Value
        Sheets(strDestSheet).Range("A1").Offset(r, 3).Value = c.Offset(0, 3).Value
        Sheets(strDestSheet).Range("A1").Offset(r, 4).Value = c.Offset(0, 4).Value
        Sheets(strDestSheet).Range("A1").Offset(r, 5).Value = c.Offset(0, 5).Value
        Sheets(strDestSheet).Range("A1").Offset(r, 6).Value = c.Offset(0, 6).Value
       'missing out here
        r = r + 1
    Next c
    MsgBox "Data copy", vbOKOnly
End Sub

Open in new window

but i'm having troble to handle the loops around each dataset in the "rawdata" section (every 15 rows are related to each other) and missing the code to built the new structure

Sincerely :-)
Question by:LDiers
    LVL 44

    Expert Comment

    Do you need the days of the week names translated?
    LVL 44

    Accepted Solution

    I added the following routine in a module.  For testing purposes, I moved the data into a new worksheet (Sheet1).  I think it is a simpler implementation of what you want to do.
    Sub Q_28499549()
        Dim rngTgt As Range
        Dim rngSrc As Range
        Dim rngDays As Range
        Dim rng As Range
        Dim wksSrc As Worksheet
        Dim wksTgt As Worksheet
        Set wksSrc = Worksheets("RawData")
        Set wksTgt = Worksheets("Sheet1")
        Set rngSrc = wksSrc.Range("A1")
        Set rngTgt = wksTgt.Range("A2")
        Application.ScreenUpdating = False
            For Each rng In wksSrc.Range(rngSrc.Offset(1, 1), rngSrc.Offset(1, 1).End(xlToRight))
                wksTgt.Range(rngTgt, rngTgt.Offset(11)).Value = rngSrc.Value
                wksTgt.Range(rngTgt, rngTgt.Offset(11)).Offset(, 1).Value = rng.Value
                wksTgt.Range(rngTgt, rngTgt.Offset(11)).Offset(, 2).Value = wksSrc.Range(rngSrc.Offset(2), rngSrc.Offset(2).End(xlDown)).Value
                wksTgt.Range(rngTgt, rngTgt.Offset(11)).Offset(, 3).Value = wksSrc.Range(rng.Offset(1), rng.Offset(1).End(xlDown)).Value
                Set rngTgt = rngTgt.End(xlDown).Offset(1)
            Set rngSrc = rngSrc.End(xlDown).End(xlDown).End(xlDown)
        Loop Until (rngSrc.Row = wksSrc.Rows.Count) _
                    Or (Len(rngSrc.Offset(1, 1).Value) = 0)
        Application.ScreenUpdating = True
    End Sub

    Open in new window

    I've also attached the updated workbook with the new code and worksheet.

    This does not clear the target worksheet, so you would need to retain that part of your code when you integrate this code into your project, or just clear manually.

    Author Closing Comment

    Great solution, much more simple! Thank you so much

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    How your wiki can always stay up-to-date

    Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
    - Increase transparency
    - Onboard new hires faster
    - Access from mobile/offline

    Introduction While answering a recent question (http:/Q_27311462.html), I created an alternative function to the Excel Concatenate() function that you might find useful.  I tested several solutions and share the results in this article as well as t…
    Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
    The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
    The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …

    737 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    16 Experts available now in Live!

    Get 1:1 Help Now