CODEWITHSUNDEEP
excelvba
Bogdan
Bogdan

Reputation: 1083

Excel VBA: copy table as a single column

I have an excel sheet that looks like this

data1 data2 data3 ... data10
 ...   ...   ...  ...  ...
dataX dataY dataZ ... dataN

I need to somhow "flatten" the data into one single column like this:

data1
data2
data3
 ...
data10
dataX
dataY
dataZ
 ...
dataN

I tried creating a macro that would automate a copy+paste process starting from a selection. Here's my code:

Sub copyIn1Col()
'
' copyIn1Col Macro
'
' Keyboard Shortcut: Ctrl+r
'
    Selection.copy
    Range("B31").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D3:D13").Select
End Sub

The problem with that is that it overwrites the copied selection to the same range.

Upvotes: 1

Views: 2796

Answers (2)

Siddharth Rout
Siddharth Rout

Reputation: 149297

The most simplest and fastest would be to use arrays. I am assuming the following

  1. The data is in Sheet1 from range A1 to E15
  2. You want the output in Sheet2 Cell A1

Hope this is what you want?

Option Explicit

Sub Sample()
    Dim inPutR, outPut()
    Dim i As Long, j As Long, n As Long

    '~~> Change this to the respective range
    inPutR = ThisWorkbook.Sheets("Sheet1").Range("A1:E15")

    ReDim Preserve outPut(UBound(inPutR, 1) * UBound(inPutR, 2))

    For i = LBound(inPutR, 1) To UBound(inPutR, 1)
        For j = LBound(inPutR, 2) To UBound(inPutR, 2)
            outPut(n) = inPutR(i, j)
            n = n + 1
        Next j
    Next i

    ThisWorkbook.Sheets("Sheet2").Range("A1").Resize(UBound(outPut) + 1) = _
    Application.Transpose(outPut)
End Sub

Upvotes: 4

Jesse
Jesse

Reputation: 1935

Here's a sub I use that I've modified to do what you're looking for. It dumps the contents in a sheet called "Data", change that to be whatever sheet you want it to add it to.

Sub Transform()

Dim rows As Long
Dim cols As Long
Dim r As Long
Dim c As Long
Dim t As Long

t = 1
rows = ActiveSheet.UsedRange.rows.Count
cols = ActiveSheet.UsedRange.Columns.Count

Application.ScreenUpdating = False

For r = 1 To rows 'If you have headers change 1 to the first row number of data
    For c = 1 To cols

        Sheets("Data").Cells(t, 1) = ActiveSheet.Cells(r, c).Value

        t = t + 1
    Next c
Next r


Application.ScreenUpdating = True

End Sub

Upvotes: 2

Related Questions