Turning around data from sheet1 to sheet2 using VBA

Question

I've looked around the internet to find an answer to my problem. I need to be able to copy data from sheet1 to sheet2 in Excel, however the rows should be turned into columns.

In sheet1 I have Title, Scope and Deadline listed in column A, and in column B the data provided to these headlines. In sheet2 I want to click on a CommandButton, which gives me Title, Scope and Deadline in A1, B1 and C1 respectively and the data below these headlines. Doing this the code should pick every fourth line in sheet1 when listing the Title in sheet2 and so on.

I have tried a little bit, put can not make it. My thoughts is to use some kind of loop.

Private sub CommandButton1_Click()
    shSource=WorkSheets("Sheet1")
    shDest=WorkSheets("Sheet2")
    LastRow = shSource.Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To LastRow
        Range("A1").Offset(4, 0).Select
        Selection.Copy
        shDest.Select
        shDest.Range("A1").Select
        If shDest.Range("A1").Offset(1, 0) <> "" Then
            shDest.Range("A1").End(xlDown).Select
        End If
        ActiveCell.Offset(1, 0).Select
        ActiveCell.Paste
    Next i
End Sub

Source sheet1

Destination Sheet2

I really hope some of you can help me. Thanks, Michelle

Use PasteSpecial Transpose while pasting See this -> http://stackoverflow.com/questions/8852717/excel-vba-range-copy-transpose-paste — Stupid_Intern, Apr 05 '16 at 13:50
Welcome to Stackoverflow. Please can youpaste an example of your Sheet1 and Sheet2. I am a bit confused as to the "every fourth line" part. and as @newguy mention you can use the `.PasteSpecial Transpose:=True` to paste a Column into rows or visa versa — Jean-Pierre Oosthuizen, Apr 05 '16 at 13:54
I formatted your code (which you should have done to make it readable to us!) and that shows that a `Next i` is missing. — Paul Ogilvie, Apr 05 '16 at 14:25

score 0 · Answer 1 · answered Apr 05 '16 at 15:09

You can try something like this:

Sub moveData()

    Set sourceSheet = Worksheets("Sheet1")
    Set targetSheet = Worksheets("Sheet2")

    lastRow = sourceSheet.Cells(1, 1).End(xlDown).Row ' assume your data starts are A1 cell
    lastColumn = sourceSheet.Cells(1, 1).End(xlToRight).Column

    For columnCounter = 1 To lastColumn
        For rowCounter = 1 To lastRow
            targetSheet.Cells(columnCounter, rowCounter) = sourceSheet.Cells(rowCounter, columnCounter)
        Next
    Next

End Sub

It is a substitute for transponse function, hope you can change it to suit your needs.

If you have problems adapting it to your case, please let me know. — Ivan Tokarev, Apr 14 '16 at 09:47

score 0 · Answer 2 · answered Apr 05 '16 at 15:12

Not perfect but should work -

  Sub test()

    Dim rngSource As Range
    Dim rngTarget As Range

    Set rngSource = Sheets("Sheet1").Range("B2")
    Set rngTarget = Sheets("Sheet2").Range("A2")

    Dim strArr() As String
    ReDim strArr(0 To 4, 0 To 0)
    Dim i As Integer
    i = 0
    Do While rngSource.Value <> ""
        With rngSource
            strArr(0, i) = .Offset(0, 0).Value
            strArr(1, i) = .Offset(1, 0).Value
            strArr(2, i) = .Offset(2, 0).Value
            strArr(3, i) = .Offset(0, 1).Value
            strArr(4, i) = .Offset(0, 2).Value
        End With
        i = i + 1
        Set rngSource = rngSource.Offset(4, 0)
        ReDim Preserve strArr(4, i)

    Loop

    Range(rngTarget, rngTarget.Offset(i, 4)).Value = _
            Application.WorksheetFunction.Transpose(strArr)

End Sub

Turning around data from sheet1 to sheet2 using VBA

2 Answers2