Excel VBA copy single column from table and transpose - excel

Question

I'm trying to copy a column from a table without it's header and transposing it into another part of the workbook.
To do so I've taken a piece of code that I've used before but can't quite tweak it to do what I want.
I was wondering if you could please help me?
I have table in "sheet 1" that has two columns and starts in cell "A3". I'm trying to copy column B, without the header, and transpose it into "sheet 2" from the cell "J2".
I can't do it via the macro recorder because if the table in sheet 1 only has one row it won't transpose into sheet 2 because it copies too many cells (and I'm learning more on how to avoid macro recorder).
This is the code I've tweaked, any help on how I can change it or use a better code?
'
' Macro21 Macro
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
'Set variables for copy and destination sheets
Set wsCopy = Worksheets("Sheet1")
Set wsDest = Worksheets("Sheet2")
'1. Find last used row in the copy range based on data in column 1
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "B").End(xlUp).Row
'2 Find first bnak row in the destination range based in column B
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
'3. Copy & Paste Data
wsCopy.Range("B4").Copy wsDest.Range("J2" & lDestLastRow)
End Sub
Thanks

Answer 1

To copy a range and then paste it transposed, you can of course use .Copy and .PasteSpecial Transpose:=True, but it will be much better to resize your destination range in such a way that you shift the orientation of your copy range, and then to apply Application.Transpose() to the rngCopy.Value.
This code should do it. Some elaboration on your comments in there to explain what everything does.
Sub TransposeRangeColumn()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Dim rngCopy As Range
'Set variables for copy and destination sheets
Set wsCopy = Worksheets("Sheet1")
Set wsDest = Worksheets("Sheet2")
'1. Find last used row in the copy range based on data in column B (!? you had "column 1")
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "B").End(xlUp).Row
'2. Set rngCopy
Set rngCopy = wsCopy.Range("B4:B" & lCopyLastRow)
'3. a) Resize destRang transposed. Example:
'Range("A1").Resize(RowSize=2, ColumnSize=3) would get you Range("A1:C2")
'we need to transpose, so input .Resize(rngCopy.ColumnSize, rngCopy.RowSize) instead
'we have 1 column, so just use 1 for the row; for columns, count rows rngCopy
'b) now that we have a transposed destination range, we want to set its value equal to
'a transposed version of rngCopy using Application.Transpose()
wsDest.Range("J2").Resize(1, rngCopy.Rows.Count).Value = Application.Transpose(rngCopy.Value)
'Code below would also have worked, but try to grow accustomed to using .Value = .Value instead
'it gives way better performance
'rngCopy.Copy
'wsDest.Range("J2").PasteSpecial Transpose:=True, Paste:=xlPasteValues
End Sub
You mentioned that your range is a table. If it is an actual Excel Table, you don't have to worry about finding/defining the first and last row of rngCopy. You can just set your range to the .DataBodyRange of the specific column you want (here: Column 2). Like this:
Sub TransposeTableColumn()
'Transpose if it's an actual table
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim rngCopy As Range
Set wsCopy = Worksheets("Sheet1")
Set wsDest = Worksheets("Sheet2")
'Use your table name instead of "Table1"
Set rngCopy = wsCopy.ListObjects("Table1").ListColumns(2).DataBodyRange
wsDest.Range("J2").Resize(1, rngCopy.Rows.Count) = Application.Transpose(rngCopy.Value)
End Sub

Answer 2

No need to use the clipboard and copy/paste operations. Do I direct write to cells and use WorksheetFunction.Transpose() to make the column into a row
Here is the code that worked for me
Option Explicit
Public Sub TestCopy()
CopyColumnTransposedTo
Sheets("Sheet1").Range ("A3"), _
2, _
Sheets("Sheet2").Range("J2")
End Sub
Public Sub CopyColumnTransposedTo(ByVal r_table As Range, column As Long, ByVal r_destination As Range)
' Move to the column on table
Set r_table = r_table.Cells(1, column)
' Count rows from end
Dim ws As Worksheet
Set ws = r_table.Worksheet
Dim count As Long
count = ws.Cells(ws.Rows.count, r_table.column).End(xlUp).Row - r_table.Row + 1
If count > 0 Then
' Copy transpose to destination
r_destination.Resize(1, count) = _
WorksheetFunction.Transpose( _
r_table.Resize(count, 1).Value)
End If
End Sub
Example results