CODEWITHSUNDEEP
excelvbatranspose
dgirl88
dgirl88

Reputation: 1

Transpose columns to rows from 1 sheet to another sheet with VBA with ongoing columns

I have a constantly-updating spreadsheet I use to track projects, but I want to create a summary view for internal stakeholders. I'm looking to transpose my columns to rows from a sheet named "Tasks" to the sheet named "Assessment Changes".

I tried to record a macro and this is what I recorded:

Sub TransposeColToRow()
    ' TransposeColToRow Macro
    Range("B3:B14").Select
    Selection.Copy
    Range("B20").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End Sub

The error message says: Run-time error '1004': This selection isn't valid. make sure the copy and paste areas don't overlap unless they are the same size and shape.

What I have currently (new projects get added to as a new column, so a new project would then go into Column I):

enter image description here

What I want is rows 2-10 being transposed to the "Assessment Changes" sheet like this, so the new columns get transposed to new rows:

enter image description here

So in my example above, when I add a new project in my "Tasks" sheet, the project gets added to Column I. But when I run the macro I had recorded, the error message pops up and doesn't copy any new columns to rows.

.

I was thinking of adding a button and assigning a VBA to it so that every time you click it, it will update with the new columns and transpose again. But I don't know how to do that. I'm fairly new to VBA so your help is greatly appreciated.

Upvotes: 0

Views: 1189

Answers (3)

dgirl88
dgirl88

Reputation: 1

I tried this based on the above feedback and some googling help and it worked well:

Sub Transpose_columns_to_rows()
  Dim sh1 As Worksheet, sh2 As Worksheet, lr As Long, j As Long
  Set sh1 = Sheets("Tasks")  'origin
  Set sh2 = Sheets("Assessment Changes")  'destiny
  sh2.Range("A6", sh2.Cells(Rows.Count, Columns.Count)).ClearContents
  lr = 6
  For j = 3 To sh1.Cells(2, Columns.Count).End(xlToLeft).Column
    sh2.Range("A" & lr).Resize(1, 10).Value = Application.Transpose(sh1.Cells(2, j).Resize(10).Value)
    lr = lr + 1
  Next
End Sub

Thanks so much for all your help!

Upvotes: 0

DisplayName
DisplayName

Reputation: 13386

as per your screenshots, you could try this:

With Sheets("Tasks").UsedRange
    .Resize(.Rows.Count - 1, .Columns.Count - 2).Offset(1, 2).Copy
End With

Sheets("Assessment Changes").Range("A6").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

Upvotes: 0

Tim Williams
Tim Williams

Reputation: 166790

Here's one way to locate the last column to copy:

Dim lastCol As Long

With Sheets("Tasks")
    'find the last used column on row 3
    lastCol = .Cells(.Columns.Count, 3).End(xlToLeft).Column
    .Range(.Range("B3"), .Cells(14, lastCol)).Copy
End With

'paste and translose
Sheets("Assessment Changes").Range("B3").PasteSpecial Paste:=xlPasteAll, _
              Operation:=xlNone, SkipBlanks:=False, Transpose:=True

Upvotes: 0

Related Questions