Need help with custom transpose pasting

[TXkleen]

I have a large data set, that is made up of 4 columns. I would like to be able to somehow quickly copy all of the data, and paste it into one column. As an example:

Raw Data:
B1, B2, B3, B4
C1, C2, C3, C4
D1, D2, D3, D4
...
Z1, Z2, Z3, Z4

Desired format of pasted/transposed data all into one column:
B1
B2
B3
B4
C1
C2
C3
C4
D1
D2
D3
D4
...
Z1
Z2
Z3
Z4

Any ideas?


Thanks!

 

[JackDanIce]

Macro is likely to be quickest way to do that.

What cell does your data start in and what is the name of that sheet? Is it always 4 columns wide?
What sheet do you want the single column to be in and in which column?

 

[TXkleen]

Data starts in B1. Sheet is always Sheet1, as I am pasting the data in from another file and creating a new file with it.
Data is always 4 columns wide.

Single column of data pasted into column G of Sheet 1 would be great.

Thank you

 

[JackDanIce]

Try:

Sub SingleCol()

    Dim x       As Long
    Dim y       As Long
    Dim i       As Long
    
    Dim arr()   As Variant
    Dim arrO()  As Variant
    
    With Sheets("Sheet1")
        y = .Cells(.Rows.count, 2).End(xlUp).row
        arr = .Cells(1, 2).Resize(y, 4).Value
        arrO = .Cells(1, 2).Resize(y * 4).Value
    End With
    
    i = LBound(arrO, 1)
    For x = LBound(arr, 1) To UBound(arr, 1)
        For y = 1 To 4
            arrO(i, UBound(arrO, 2)) = arr(x, y)
            i = i + 1
        Next y
    Next x
    
    Sheets("Sheet1").Cells(1, 7).Resize(UBound(arrO, 1), UBound(arrO, 2)).Value = arrO
        
    Erase arr
    Erase arrO
    
End Sub

 

[oldbrewer]

b1	b2	b3	b4
c1	c2	c3	c4
d1	d2	d3	d4
e1	e2	e3	e4
f1	f2	f3	f4
g1	g2	g3	g4
b1
b2			this macro does what you want
b3
b4			if you attach it to a shape
c1			clicking on that shape
c2			will run the macro
c3
c4			Sub Macro4()
d1			'
d2			' Macro4 Macro
d3			' Macro recorded 14/11/2017 by bob
d4			'
e1
e2			'
e3			rrow = 9
e4			For j = 1 To 6
f1			For k = 1 To 4
f2			rrow = rrow + 1
f3			Cells(rrow, 1) = Cells(j, k)
f4			Next k
g1			Next j
g2			End Sub
g3
g4

<colgroup><col width="64" span="9" style="width:48pt"> </colgroup><tbody>
</tbody>

 

[TXkleen]

Try:

Sub SingleCol()

    Dim x       As Long
    Dim y       As Long
    Dim i       As Long
    
    Dim arr()   As Variant
    Dim arrO()  As Variant
    
    With Sheets("Sheet1")
        y = .Cells(.Rows.count, 2).End(xlUp).row
        arr = .Cells(1, 2).Resize(y, 4).Value
        arrO = .Cells(1, 2).Resize(y * 4).Value
    End With
    
    i = LBound(arrO, 1)
    For x = LBound(arr, 1) To UBound(arr, 1)
        For y = 1 To 4
            arrO(i, UBound(arrO, 2)) = arr(x, y)
            i = i + 1
        Next y
    Next x
    
    Sheets("Sheet1").Cells(1, 7).Resize(UBound(arrO, 1), UBound(arrO, 2)).Value = arrO
        
    Erase arr
    Erase arrO
    
End Sub

Perfect. Thank you sir!

 

[JackDanIce]

You're welcome